Ghép nhiều file .xls thành 1 file chung

[BlankMan]

Tôi sử dụng đoạn code sau để ghép nhiều file excel thành 1 file, nhưng không hiểu sao không ra kết quả. Hình như nó có copy nhưng nó không paste được vào file chung.
Các bạn xem giúp với

Sub Tonghop()
Dim FolderName As String, wbName As String
Dim t As Integer, m As Integer
FolderName = ActiveWorkbook.Path
wbName = Dir(FolderName & "\" & "*.xlsx")
Application.ScreenUpdating = False
      While wbName <> ""
            If wbName <> "Tonghop.xlsx" Then
                   Workbooks.Open ActiveWorkbook.Path & "\" & wbName
                   Workbooks(wbName).Activate
                   Workbooks(wbName).ActiveSheet.Select
                   Cells(2, 1).Select
                   Selection.CurrentRegion.Offset(1).Select
                   t = Selection.Rows.Count - 1
                   Selection.Copy
                   Windows(wbName).Visible = False
                   Windows("Tonghop").Activate
                   Sheets("Tonghop").Select
                   Cells(2 + m, 1).Select
                   ActiveSheet.Paste
                   m = t + m
                   Application.DisplayAlerts = False
                   Workbooks(wbName).Close
            End If
                   wbName = Dir
     Wend
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub

Cảm ơn rất nhiều

 

[tintam7251]

Bạn chạy code không ra kết quả. Nó có báo lỗi gì không? Các file bạn sử dụng có cấu trúc thế nào? Bạn cần mô tả rõ hơn hoặc gởi các file giả lập lên, người khác mới có thể giúp bạn được.

 

[sealand]

Chép dữ liệu từ các Workbook khác nhau bạn phải chỉ rõ tường minh cả nguồn và đích:
-Workbook nào
-Sheet thứ mấy hoặc tên là gì?
-Vùng nào ?

Nếu chỉ Active nó lên là không được

 

[sealand]

Bạn tham khảo mình sửa code của bạn (Lưu ý mình dung Ex2003 nên đuôi file khác 1 chút)

Sub Tonghop()
  Dim FolderName As String, wbName As String
   Dim t As Integer, m As Integer
     Dim Wb1 As Workbook, Cl As Range
      Sheet1.[A2:A65536].Clear
        FolderName = ActiveWorkbook.Path
          wbName = Dir(FolderName & "\" & "*.xls")
           Application.ScreenUpdating = False
            While wbName <> ""
              If wbName <> "TongHop.xls" Then
                Set Cl = Sheet1.[A65000].End(3).Offset(1)
               Set Wb1 = Workbooks.Open(ActiveWorkbook.Path & "\" & wbName)
             Wb1.Worksheets("Sheet1").[A1].CurrentRegion.Offset(1).Copy Cl
            MsgBox "Da chep xong file: " & wbName
          Workbooks(wbName).Close
         End If
       wbName = Dir
     Wend
  Application.ScreenUpdating = True
End Sub