Chuyển 1 sheet thành 1 file

Vinix · 27/4/10

Mình có 1 file excel gồm nhiều sheet. Nay muốn xuất 1 sheet thành 1 file riêng biệt, có tên là tên của sheet đó thì phải làm thế nào. Google mấy ngày rùi hok ra. Các bác giúp em với.

Minh Đức 1309 · 7/6/19

Hai Lúa Miền Tây đã viết:
Thì bạn thay thế cái Thisworkbook.path thành đường dẫn là được nhé.

Mã:

Sub LuuFile() With Application .ScreenUpdating = False .DisplayAlerts = False Sheets("Sheet1").Copy ActiveWorkbook.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheets("Sheet1").Range("A1") .DisplayAlerts = True .ScreenUpdating = True End With End Sub

Thầy ơi cho con hỏi thêm là cái sheet mình tach ra là 1 vùng dữ liệu mình muốn khi tách thành file mới n đặt name cho vùng dữ liệu ở file mới luôn thì sao ạ

Hai Lúa Miền Tây · 7/6/19

Minh Đức 1309 đã viết:
Thầy ơi cho con hỏi thêm là cái sheet mình tach ra là 1 vùng dữ liệu mình muốn khi tách thành file mới n đặt name cho vùng dữ liệu ở file mới luôn thì sao ạ

Đặt name cho vùng thì gán như sau:

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10" ' Vung A1:C10 cua sheet1'
         ActiveWorkbook.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Minh Đức 1309 · 7/6/19

Hai Lúa Miền Tây đã viết:

Đặt name cho vùng thì gán như sau:

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10" ' Vung A1:C10 cua sheet1'
         ActiveWorkbook.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Code này thì tách sheet thành file nhưng vẫn giữ nguyên sheet ở file gốc,con muốn tách xong xóa sheet ở file gốc thì sao ạ.

Hai Lúa Miền Tây · 7/6/19

Minh Đức 1309 đã viết:
Code này thì tách sheet thành file nhưng vẫn giữ nguyên sheet ở file gốc,con muốn tách xong xóa sheet ở file gốc thì sao ạ.

Bạn xóa bình thường thôi nhé. Tuy nhiên khi xóa sheet đó rồi thì code sau này tìm sheet đó ở đâu để copy tiếp?

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"
         ActiveWorkbook.Close True, "D:\" & Sheets("Sheet1").Range("A1")
         If Worksheets.Count > 1 Then
            Sheets("Sheet1").Delete
         Else
            MsgBox "Khong the xoa sheet khi file chi co 1 sheet"
            
         End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Minh Đức 1309 · 7/6/19

Hai Lúa Miền Tây đã viết:

Bạn xóa bình thường thôi nhé. Tuy nhiên khi xóa sheet đó rồi thì code sau này tìm sheet đó ở đâu để copy tiếp?

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"
         ActiveWorkbook.Close True, "D:\" & Sheets("Sheet1").Range("A1")
         If Worksheets.Count > 1 Then
            Sheets("Sheet1").Delete
         Else
            MsgBox "Khong the xoa sheet khi file chi co 1 sheet"
           
         End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Thầy ơi có hàm nào đổi từ ngày âm sang ngày dương k ạ

Minh Đức 1309 · 7/6/19

Minh Đức 1309 đã viết:
Thầy ơi có hàm nào đổi từ ngày âm sang ngày dương k ạ

Dạ con muốn dùng câu lệnh
Sub copysheets()
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "KHO"
Sheets("Sheet3").Select
Selection.Copy
Sheets("KHO").Select
Range("B6").Select
ActiveSheet.Paste
End Sub
để copy sang sheet mới đổi tên là kho rồi sẽ tách ạ.Nhưng khúc mắc ở chỗ cứ thêm sheet mới thì tên sheet sẽ tăng là sheet 4 chứ k còn là sheet 3 nữa lên code k chạy Thầy khắc phục giúp con với ạ.Tại con chỉ muốn copy 1 vùng giữ liệu trong sheet thành file mới với dữ liệu ở đó được paste value chứ k còn có công thức ạ

Minh Đức 1309 · 7/6/19

Minh Đức 1309 đã viết:
Thầy ơi có hàm nào đổi từ ngày âm sang ngày dương k ạ

Hoặc là copy cả sheet nhưng con muốn paste value thôi k có công thức trong file copy thì làm ntn thầy ơi

Hai Lúa Miền Tây · 8/6/19

Minh Đức 1309 đã viết:
Dạ con muốn dùng câu lệnh
Sub copysheets()
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "KHO"
Sheets("Sheet3").Select
Selection.Copy
Sheets("KHO").Select
Range("B6").Select
ActiveSheet.Paste
End Sub
để copy sang sheet mới đổi tên là kho rồi sẽ tách ạ.Nhưng khúc mắc ở chỗ cứ thêm sheet mới thì tên sheet sẽ tăng là sheet 4 chứ k còn là sheet 3 nữa lên code k chạy Thầy khắc phục giúp con với ạ.Tại con chỉ muốn copy 1 vùng giữ liệu trong sheet thành file mới với dữ liệu ở đó được paste value chứ k còn có công thức ạ

Vậy thì cứ việc copy thôi bạn, đâu cần phải thêm sheet mới rồi copy, sau khi copy thì xóa sheet mới đó. Như vậy nó lòng vòng.
Chỉ việc copy vùng của sheet1 sang file mới rồi lưu file đó lại thôi. Vùng cần copy và đường dẫn thì bạn tự điều chỉnh theo ý nhé.

Mã:

Sub LuuFile_1()
    Dim newWB As Workbook
    Set newWB = Workbooks.Add
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        ThisWorkbook.Sheets("Sheet1").Range("A1:C10").Copy
        newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
        newWB.Close True, "D:\" & ThisWorkbook.Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Minh Đức 1309 · 8/6/19

Hai Lúa Miền Tây đã viết:
Vậy thì cứ việc copy thôi bạn, đâu cần phải thêm sheet mới rồi copy, sau khi copy thì xóa sheet mới đó. Như vậy nó lòng vòng.
Chỉ việc copy vùng của sheet1 sang file mới rồi lưu file đó lại thôi. Vùng cần copy và đường dẫn thì bạn tự điều chỉnh theo ý nhé.

Mã:

Sub LuuFile_1() Dim newWB As Workbook Set newWB = Workbooks.Add With Application .ScreenUpdating = False .DisplayAlerts = False ThisWorkbook.Sheets("Sheet1").Range("A1:C10").Copy newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues newWB.Close True, "D:\" & ThisWorkbook.Sheets("Sheet1").Range("A1") .DisplayAlerts = True .CutCopyMode = False .ScreenUpdating = True End With End Sub

Sub Luufile()
Dim newWB As Workbook
Set newWB = Workbooks.Add
Sheet2.Activate
Names.Add Name:="KHO", RefersTo:=Range("A1", Range("G1").End(xlDown).Offset(2, 0))

With Application
.ScreenUpdating = False
.DisplayAlerts = False
ThisWorkbook.Sheet2.Range("A8").CurrentRegion.Copy
newWB.Sheets("Sheet1").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
newWB.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheet2.Range("K3")
.DisplayAlerts = True
.ScreenUpdating = True
End With

MsgBox "Luu file ngày : " & Sheet2.Range("k3") & " thành công"

End Sub
THẦY XEM GIÚP CON CODE SAI Ở ĐÂU VỚI Ạ.Tại con muốn paste value giữ định dạng đấy ạ

Minh Đức 1309 · 8/6/19

Hai Lúa Miền Tây đã viết:
ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"

Hai Lúa Miền Tây đã viết:
ctiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10

Hai Lúa Miền Tây đã viết:

Bạn xóa bình thường thôi nhé. Tuy nhiên khi xóa sheet đó rồi thì code sau này tìm sheet đó ở đâu để copy tiếp?

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"
         ActiveWorkbook.Close True, "D:\" & Sheets("Sheet1").Range("A1")
         If Worksheets.Count > 1 Then
            Sheets("Sheet1").Delete
         Else
            MsgBox "Khong the xoa sheet khi file chi co 1 sheet"
           
         End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Sub Luufile()
Dim newWB As Workbook
Set newWB = Workbooks.Add
Workbooks("NL&KT").Sheets("SO_CHITIET").Activate
Names.Add Name:="KHO", RefersTo:=Range("A2", Range("G2").End(xlDown).Offset(2, 0))

With Application
.ScreenUpdating = False
.DisplayAlerts = False
ThisWorkbook.Sheets("SO_CHITIET").Range("A8").CurrentRegion.Copy
newWB.Activate
newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
newWB.Names.Add Name:="KHO", RefersTo:=Range("A2").CurrentRegion
newWB.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheet2.Range("K3")
.DisplayAlerts = True
.ScreenUpdating = True
End With

MsgBox "Luu file ngày : " & Sheet2.Range("k3") & " thành công"

End Sub
Con đã sửa code nhưng k paste được value giữ nguyên định dạng thầy giúp con với.Do k có điều kiện toàn tự học,phiền thầy nhiều

Love GPE · 1/12/20

Hai Lúa Miền Tây đã viết:

Dùng code sau:

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
      '  .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveSheet.Name = "TenSheetMoi"
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
       ' .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   
End Sub

Cảm ơn Anh Hai Lúa Miền Tây, đã chia sẻ đoạn code rất hay. Em muốn bổ sung thêm vào 1 trường hợp là kết xuất sheet ra file mới thì file mới nó chuyển thành giá trị (không còn công thức bên trong). Do có khi sheet chỉ là số liệu tổng hợp từ các sheet khác vào. Nên nếu kết xuất mà không chuyển sang value thì sẽ bị lỗi. Mong Anh giúp Em thêm. Cảm ơn Anh nhiều!

Hai Lúa Miền Tây · 2/12/20

Love GPE đã viết:
Cảm ơn Anh Hai Lúa Miền Tây, đã chia sẻ đoạn code rất hay. Em muốn bổ sung thêm vào 1 trường hợp là kết xuất sheet ra file mới thì file mới nó chuyển thành giá trị (không còn công thức bên trong). Do có khi sheet chỉ là số liệu tổng hợp từ các sheet khác vào. Nên nếu kết xuất mà không chuyển sang value thì sẽ bị lỗi. Mong Anh giúp Em thêm. Cảm ơn Anh nhiều!

Bạn có thể chuyển nó thành value như sau nhé.

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         Cells.Copy
         Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
  
End Sub

Love GPE · 2/12/20

Hai Lúa Miền Tây đã viết:

Bạn có thể chuyển nó thành value như sau nhé.

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         Cells.Copy
         Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
 
End Sub

Hai Lúa Miền Tây đã viết:

Bạn có thể chuyển nó thành value như sau nhé.

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         Cells.Copy
         Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
 
End Sub

Anh ơi Em chạy thử code thì nó đang chuyển thành Value ở sheet nguồn. Còn sheet ở file mới thì nó chưa chuyển được sang Value Anh ạ. Mong Anh xem giúp Em. Cảm ơn Anh nhiều!

Hai Lúa Miền Tây · 2/12/20

Love GPE đã viết:
Anh ơi Em chạy thử code thì nó đang chuyển thành Value ở sheet nguồn. Còn sheet ở file mới thì nó chưa chuyển được sang Value Anh ạ. Mong Anh xem giúp Em. Cảm ơn Anh nhiều!

Vậy bạn thử cho nó vào ActiveSheet xem sao nhé.

Rich (BB code):

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         ActiveSheet.Cells.Copy
         ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
 
End Sub

Love GPE · 2/12/20

Hai Lúa Miền Tây đã viết:

Vậy bạn thử cho nó vào ActiveSheet xem sao nhé.

Rich (BB code):

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         ActiveSheet.Cells.Copy
         ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With

End Sub

Dạ được rồi Anh ạ. Cảm ơn Anh nhiều!

FAPV · 20/11/23

Hai Lúa Miền Tây đã viết:

Dùng code sau:

Mã:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
      '  .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveSheet.Name = "TenSheetMoi"
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
       ' .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   
End Sub

Code này rất hay , đã thực hiện thành công
còn một điểm nhờ giúp đỡ,
khi xuất ra cho thêm lệnh xóa đi công thức được không?, chỉ một vùng nào đó trong sheet

Hoàng Tuấn 868 · 20/11/23

FAPV đã viết:
Code này rất hay , đã thực hiện thành công
còn một điểm nhờ giúp đỡ,
khi xuất ra cho thêm lệnh xóa đi công thức được không?, chỉ một vùng nào đó trong sheet

Câu này cũng rất hay, nếu đoạn đầu thêm phần chào hỏi, đoạn cuối thêm câu cảm ơn nữa thì hoàn hảo.

VetMini · 20/11/23

Hoàng Tuấn 868 đã viết:
Câu này cũng rất hay, nếu đoạn đầu thêm phần chào hỏi, đoạn cuối thêm câu cảm ơn nữa thì hoàn hảo.

Hoàn hảo mốc xì.
"công thức" ở đâu ra mà xóa?

Hoàng Tuấn 868 · 20/11/23

VetMini đã viết:
Hoàn hảo mốc xì.
"công thức" ở đâu ra mà xóa?

Em chỉ lưu ý phần đầu và phần cuối thôi, đoạn giữa em bỏ qua rồi anh ơi.

Chuyển 1 sheet thành 1 file

Thành viên mới

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên chính thức

Thành viên mới

Đăng ký hôm qua

Ăn cùng góc phố

Đăng ký hôm qua