Xem lại code ghép nhiều file làm 1 file

[nguyentheviet86]

Nhờ các anh chị xem giúp em code, ghép nhiều file làm 1 file.
Em chỉ ghép được có 1 file, nhờ các anh chị giúp, em cảm ơn ạ

 

[HUONGHCKT]

Nhờ các anh chị xem giúp em code, ghép nhiều file làm 1 file.
Em chỉ ghép được có 1 file, nhờ các anh chị giúp, em cảm ơn ạ

Thay code này vào và thử.

Sub GopFileExcel()
    Dim FilesToOpen
    Dim x As Integer
    Dim wb As Workbook
    Dim LrN&, LrD&
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

   
      FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm", MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
        If x = 1 Then
            LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
            wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A1")
        Else
            LrD = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
            LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
           wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A" & LrD + 1)      'thay chỗ tô đậm    wb.Sheets(1).Range("A1:K" & LrN).Copy
        End If
        
        wb.Close False
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wb = Nothing
    MsgBox "Xong"
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
    
End Sub

Vẫn code của bạn, tôi có sửa chút ít.
Tôi không hiểu bạn copy toàn bộ bộ vùng từ A1:K13 của Sh1 /wb từ thứ 2 để làm gì.
nếu chỉ lấy phần dữ liệu từ A13:K dòng cuối thì thay chỗ tô đậm
.....
LrD = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A" & LrD + 1) 'thay chỗ tô đậm wb.Sheets(1).Range("A1:K" & LrN).Copy
End If
.....

 

[nguyentheviet86]

Thay code này vào và thử.

Sub GopFileExcel()
    Dim FilesToOpen
    Dim x As Integer
    Dim wb As Workbook
    Dim LrN&, LrD&
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

  
      FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm", MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
        If x = 1 Then
            LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
            wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A1")
        Else
            LrD = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
            LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
           wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A" & LrD + 1)      'thay chỗ tô đậm    wb.Sheets(1).Range("A1:K" & LrN).Copy
        End If
       
        wb.Close False
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wb = Nothing
    MsgBox "Xong"
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
   
End Sub

Vẫn code của bạn, tôi có sửa chút ít.
Tôi không hiểu bạn copy toàn bộ bộ vùng từ A1:K13 của Sh1 /wb từ thứ 2 để làm gì.
nếu chỉ lấy phần dữ liệu từ A13:K dòng cuối thì thay chỗ tô đậm
.....
LrD = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A" & LrD + 1) 'thay chỗ tô đậm wb.Sheets(1).Range("A1:K" & LrN).Copy
End If
.....

Thay code này vào và thử.

Sub GopFileExcel()
    Dim FilesToOpen
    Dim x As Integer
    Dim wb As Workbook
    Dim LrN&, LrD&
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

  
      FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm", MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
        If x = 1 Then
            LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
            wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A1")
        Else
            LrD = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
            LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
           wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A" & LrD + 1)      'thay chỗ tô đậm    wb.Sheets(1).Range("A1:K" & LrN).Copy
        End If
       
        wb.Close False
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wb = Nothing
    MsgBox "Xong"
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
   
End Sub

Vẫn code của bạn, tôi có sửa chút ít.
Tôi không hiểu bạn copy toàn bộ bộ vùng từ A1:K13 của Sh1 /wb từ thứ 2 để làm gì.
nếu chỉ lấy phần dữ liệu từ A13:K dòng cuối thì thay chỗ tô đậm
.....
LrD = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
LrN = wb.Sheets(1).Range("A100000").End(xlUp).Row
wb.Sheets(1).Range("A1:K" & LrN).Copy ThisWorkbook.Sheets(1).Range("A" & LrD + 1) 'thay chỗ tô đậm wb.Sheets(1).Range("A1:K" & LrN).Copy
End If
.....

Em cảm ơn anh chị nhiều nhé, em đã sửa theo cái phần tô đậm rồi ah

 

[nguyentheviet86]

Em cảm ơn anh chị nhiều nhé, em đã sửa theo cái phần tô đậm rồi ah

Nhờ anh chị viết thêm giúp em điều kiện cho file OVT này không ạ.
Nếu ko nhập đầy đủ thông tin cột C, H,I,J thì sẽ không được nhập vào dữ liệu
Em cảm ơn anh chị !

 

[HUONGHCKT]

Nhờ anh chị viết thêm giúp em điều kiện cho file OVT này không ạ.
Nếu ko nhập đầy đủ thông tin cột C, H,I,J thì sẽ không được nhập vào dữ liệu
Em cảm ơn anh chị !
View attachment 271271

Tôi đang sử dụng đt nên không làm giúp bạn được.
Hỏi thêm:
Là thiếu dữ liệu của ít nhất 1 trong số các cột trên là không cho nhập, hay là chỉ cần ít nhất 1 trong số các cột trên có dữ liệu thì cho nhập dòng đó và ngược lại.