Append data after last row - excel

Question

My macro is to append the values from three sheets in a weekly report workbook to the values in equivalent sheets in an accumulating workbook.
However, I cannot define the ranges in the ThisWorkbook.Sheets correctly - Only the cell A2 values from the wb.Sheets are appended.
Could someone please help me define the range correctly? Many thanks!
Sub Import_SheetData_ThisWorkbook()
Dim lRow As Long, lRow1 As Long, lRow2 As Long, lRow3 As Long
Dim Path As String, WeeklyCollation As String
Dim wkNum As Integer
Dim wb As Workbook
wkNum = Application.InputBox("Enter week number")
Path = "C:\xyz\"
WeeklyCollation = Path & "Activities 2021 w" & wkNum & ".xlsx"
lRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set wb = Workbooks.Open(WeeklyCollation)
lRow1 = wb.Sheets("Customer visits").Cells(Rows.Count, 1).End(xlUp).Row
lRow2 = wb.Sheets("Orders").Cells(Rows.Count, 1).End(xlUp).Row
lRow3 = wb.Sheets("Visits").Cells(Rows.Count, 1).End(xlUp).Row
'Replace with copy and paste
'Can't define range in ThisWorkbook
ThisWorkbook.Sheets("Customer visits").Range("A" & lRow + 1).Value = wb.Sheets("Customer visits").Range("A2:H" & lRow1).Value
ThisWorkbook.Sheets("Orders").Range("A" & lRow + 1).Value = wb.Sheets("Orders").Range("A2:I" & lRow2).Value
ThisWorkbook.Sheets("Visits").Range("A" & lRow + 1).Value = wb.Sheets("Visits").Range("A2:F" & lRow3).Value
wb.Close SaveChanges:=False
MsgBox ("Data added")
End Sub

Answer 1

Backup Data
Adjust the values in the constants section.
Option Explicit
Sub ImportSheetData()
' Constants
' Source
Const sPath As String = "C:\xyz\"
Const swsNamesList As String = "Customer visits,Orders,Visits"
Const slrCol As String = "A"
Const sfRow As Long = 2
' Destination
Const dwsNamesList As String = "Customer visits,Orders,Visits"
Const dlrCol As String = "A"
' Both
Const Cols As String = "A:H"
' Create the references to the workbooks.
Dim wkNum As Variant: wkNum = Application.InputBox( _
"Enter week number", "Import Sheet Data", , , , , , 1)
If wkNum = False Then
MsgBox "You canceled.", vbExclamation
Exit Sub
End If
Dim sWeeklyCollation As String
sWeeklyCollation = sPath & "Activities 2021 w" & wkNum & ".xlsx"
Dim swb As Workbook
On Error Resume Next
Set swb = Workbooks.Open(sWeeklyCollation)
On Error GoTo 0
If swb Is Nothing Then
MsgBox "Could not find the file '" & sWeeklyCollation & "'.", vbCritical
Exit Sub
End If
Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
' Copy the data.
Dim swsNames() As String: swsNames = Split(swsNamesList, ",")
Dim dwsNames() As String: dwsNames = Split(dwsNamesList, ",")
Dim sws As Worksheet
Dim srg As Range
Dim slRow As Long
Dim dws As Worksheet
Dim drg As Range
Dim dCell As Range
Dim n As Long
Dim rCount As Long
Dim wsCount As Long ' Counts the number of worksheets processed
For n = 0 To UBound(swsNames)
On Error Resume Next
Set sws = swb.Worksheets(swsNames(n))
On Error GoTo 0
If Not sws Is Nothing Then ' source worksheet exists
On Error Resume Next
Set dws = dwb.Worksheets(dwsNames(n))
On Error GoTo 0
If Not dws Is Nothing Then ' destination worksheet exists
slRow = sws.Cells(sws.Rows.Count, slrCol).End(xlUp).Row
rCount = slRow - sfRow + 1
If rCount > 0 Then ' found data in source worksheet
Set srg = sws.Columns(Cols).Resize(rCount).Offset(sfRow - 1)
Set dCell = dws.Cells(dws.Rows.Count, dlrCol) _
.End(xlUp).Offset(1)
Set drg = dCell.Resize(rCount).EntireRow.Columns(Cols)
drg.Value = srg.Value
wsCount = wsCount + 1
' Else ' no data in source worksheet
End If
'Else ' destination worksheet doesn't exist
End If
'Else ' source worksheet doesn't exist
End If
Next n
' Finishing Touches
swb.Close SaveChanges:=False
'dwb.Save
' Or:
'dwb.Close SaveChanges:=True
MsgBox "Data from " & wsCount & " worksheets added.", vbInformation
End Sub