Nối file excel - copy nhiều sheet từ nhiều file [VBA]


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

Post a Comment

Previous Post Next Post