Bạn cần nối nhiều file excel thành một file, bạn cần nối sheet đầu tiên của nhiều file excel để tiện in ấn. Hôm nay Xtea giới thiệu đến các bạn cách copy sheet hàng loạt bằng VBA.
Các bạn tải file hoàn chỉnh bên dưới, mở file, chọn Enable macro, nhấn nút RUN và chọn các file cần copy sheet đầu tiên của mỗi file nhé. Code sẽ chạy và copy lần lượt các sheet đầu tiên của mỗi file, đặt tên theo cú pháp "tên sheet tên file". Sau khi hoàn thành sẽ có một bản thông báo, và nếu bạn chưa theo dõi Xtea thì nhấn vào OK ủng hộ nhé.
Mình để luôn code mẫu ở đây
Sub copydata()
Application.ScreenUpdating = False
Dim file As Variant
Dim i As Integer
Dim wb As Workbook
Dim filename As String
filename = ActiveWorkbook.Name
file = Application.GetOpenFilename(Filefilter:="Excel file (*.xlsx), *.xls", MultiSelect:=True)
For i = 1 To UBound(file)
Set wb = Workbooks.Open(file(i))
Sheets(1).Select 'CHỌN SHEET ĐẦU TIÊN
Sheets(1).Name = Split(wb.Name, ".xls")(0) 'ĐẶT LẠI TÊN
ActiveSheet.Copy After:=Workbooks(filename).Sheets(Workbooks(filename).Worksheets.Count)
wb.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
End Sub
Nếu bạn cần copy tất cả các sheet của file thì thêm 1 vòng lặp for vào như bên dưới nhé
Sub copydata()
Application.ScreenUpdating = False
Dim file As Variant
Dim i, j As Integer
Dim wb As Workbook
Dim filename As String
filename = ActiveWorkbook.Name
file = Application.GetOpenFilename(Filefilter:="Excel file (*.xlsx), *.xls", MultiSelect:=True)
If Not IsArray(file) Then Exit Sub
For i = 1 To UBound(file)
Set wb = Workbooks.Open(file(i))
For j = 1 To wb.Worksheets.Count 'THÊM VÒNG LẶP FOR ĐỂ DUYỆT TẤT CẢ SHEETS
wb.Activate
Sheets(j).Select
Sheets(j).Name = Sheets(j).Name + " " + Split(wb.Name, ".xls")(0)
ActiveSheet.Copy After:=Workbooks(filename).Sheets(Workbooks(filename).Worksheets.Count)
Next
wb.Close SaveChanges:=False
Next
answer = MsgBox("Ðã sao chép xong, theo dõi Xtea nhé!", vbInformation + vbOKCancel + vbDefaultButton2, "Xtea.vn")
If answer = vbOK Then
Shell "explorer ""https://www.facebook.com/Xtea.vn/reviews/"""
End If
Application.ScreenUpdating = True
End Sub
