I've wanted to copy and paste specific data on existing worksheet from workbook loaded

Question

I've wanted to copy and paste specific data on existing worksheet from workbook loaded.

Code is running till get to below row.. (Please find full code on below)

rng.Copy worksheet("WMS").Cells(j, 39)

I guess it has problem with this worksheet("WMS") (WMS worksheet is existing worksheet)in with loop but has no clue to solve this problem.

Would you give me advise what should I try? thanks.

Private Sub btnMerge_Click()
 
Dim WB As Workbook
Dim WS As Worksheet: Dim toWS As Worksheet

Dim rng As Range
Dim i As Long: i = 0: Dim j As Long
Dim endCol As Long: Dim endRow As Long
Dim strWS As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
If Me.lstWB.ListCount = 0 Then
    MsgBox "No file have selected"
    Exit Sub
End If
 
Set toWS = ActiveSheet
j = toWS.Cells(toWS.Rows.Count, 1).End(xlUp).Row
 
For i = 0 To Me.lstWB.ListCount - 1
    Set WB = Application.Workbooks.Open(Me.lstWB.List(i))
    
    For Each WS In WB.Worksheets
    
            With WS
                endCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                Set rng = .Range(.Cells(2, 1), .Cells(2, endRow))
                
                rng.Copy worksheet("WMS").Cells(j, 39)
                j = j + rng.Rows.Count
 
            End With
    Next
    WB.Close
Next
 
MsgBox "Done"
Unload Me
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

Answer 1

Change

Set rng = .Range(.Cells(2, 1), .Cells(2, endRow))

to

Set rng = .Range(.Cells(2, 1), .Cells(endRow, endCol))

Using variant array is more effective. .rows.count is same with rows.count . Because the number of rows of all sheets is the same.

Private Sub btnMerge_Click()
 
Dim WB As Workbook
Dim WS As Worksheet: Dim toWS As Worksheet

Dim rng As Range
Dim i As Long: i = 0: Dim j As Long
Dim endCol As Long: Dim endRow As Long
Dim strWS As String
Dim Target As Range, vDB As Variant


Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
If Me.lstWB.ListCount = 0 Then
    MsgBox "No file have selected"
    Exit Sub
End If
 
Set toWS = ActiveSheet
'j = toWS.Cells(toWS.Rows.Count, 1).End(xlUp).Row
 
For i = 0 To Me.lstWB.ListCount - 1
    Set WB = Application.Workbooks.Open(Me.lstWB.List(i))
    
    For Each WS In WB.Worksheets
    
            With WS
                endCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                'Set rng = .Range(.Cells(2, 1), .Cells(2, endRow))
                vDB = .Range(.Cells(2, 1), .Cells(endRow, endCol))

                'rng.Copy Worksheet("WMS").Cells(j, 39)
                Set Target = toWS.Cells(Rows.Count, 39).End(xlUp)(2)
                'j = j + rng.Rows.Count
                Target.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
 
            End With
    Next
    WB.Close
Next
 
MsgBox "Done"
Unload Me
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub