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