1 Gộp nhiều File Folder vào thành Excel tổng hợp - Tạo excel cần tổng hợp vào coppy đoạn mã VBA vào: Sub Gop_File() Path = "C:\Users\Quan\Desktop\Report\" 'Đây đường dẫn thư mục chứa file tạo folder chứa file cần ghép pase đường dẫn vào Filename = Dir(Path & "*.xlsx") Do While Filename "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub Gộp nhiều Sheets thành sheet tổng hợp Option Explicit Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo End Function Function Lastcol(sh As Worksheet) On Error Resume Next Lastcol = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column On Error GoTo End Function Sub CopyTheUsedRangeOfEachSheet() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long On Error Resume Next If Len(ThisWorkbook.Worksheets.Item("Master").Name) = Then On Error GoTo Application.ScreenUpdating = False Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "Master" For Each sh In ThisWorkbook.Worksheets If sh.Name DestSh.Name Then Last = LastRow(DestSh) sh.UsedRange.Copy DestSh.Cells(Last + 1, "A") 'Instead of this line you can use the code below to copy only the values 'or use the PasteSpecial option to paste the format also 'With sh.UsedRange 'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _ '.Columns.Count).Value = Value 'End With 'sh.UsedRange.Copy 'With DestSh.Cells(Last + 1, "A") ' PasteSpecial xlPasteValues, , False, False ' PasteSpecial xlPasteFormats, , False, False ' Application.CutCopyMode = False 'End With End If Next DestSh.Cells(1).Select Application.ScreenUpdating = True Else MsgBox "The sheet Master already exist" End If End Sub ... ''End With End If Next DestSh.Cells(1).Select Application.ScreenUpdating = True Else MsgBox "The sheet Master already exist" End If End Sub