Copying rows from several sheets, where sheet data exists, to one sheet of another file in Excel VBA

I need to copy rows with four columns from one workbook containing four sheets "data.xlsx" (sheets 1, 2, 3, 4) to one sheet on another workbook named "newdata.xlsm" (sheet 1).

For sheets 1, 2, 3, 4 in "data.xlsx" the number of rows can be anywhere from 0 to 60 (usually 0 to 20 rows).

When one or several sheets in data.xlsx has zero rows the macro generates

>VBA Error 1004 – Application-Defined or Object-Defined Error

If for example sheet 2 has zero rows. Excel gets an error on:

'copy 
column 1 worksheets("worksheet2").cells(p,1).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(q,1)

as q=0. I understand it is not possible to copy text to row = 0.

I started to dabble with "goto"-statements but quickly surrendered as I realized I was in deep water.

sub copyfile

'read data.xlsx file

'open data file
workbooks.open filename :=thisworkbook.path & "\data.xlsx"

dim x as integer

'dim lr as long
lr= cells(rows.count,1).end(xlup).row

for x = 2 to lr

'copy rows from sheet1 on data.xlsx to new file, new file called "newdata.xlsm"

'copy column 1 
worksheets("worksheet1").cells(x,1).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(x,1)

'copy column 2
worksheets("worksheet1").cells(x,2).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(x,2)

'copy column 3
worksheets("worksheet1").cells(x,3).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(x,3)

'copy column 4
worksheets("worksheet1").cells(x,4).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(x,4)

next x

windows("data.xlsx").Activate
Sheets("Worksheet2").Activate

'dim copy worksheet 2
dim y as integer
dim z as integer
dim lr_y as long

'no of rows on worksheet2
lr_y = cells(rows.count,1).end(xlup).row
For y = 2 to lr_y

For z = (y + x) -2 to lr_y + x - 2

'copy rows from sheet2 on data.xlsx to new file, new file called "newdata.xlsm"

'copy column 1 
worksheets("worksheet2").cells(y,1).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(z,1)

'copy column 2
worksheets("worksheet2").cells(y,2).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(z,2)

'copy column 3
worksheets("worksheet2").cells(y,3).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(z,3)

'copy column 4
worksheets("worksheet2").cells(y,4).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(z,4)

next z
next y

windows("data.xlsx").Activate
Sheets("Worksheet3").Activate

'dim copy worksheet 3
dim p as integer
dim q as integer
dim lr_p as long

'no of rows on worksheet3
lr_p = cells(rows.count,1).end(xlup).row
For p = 2 to lr_p

For q = (p+z) -2 to lr_p + z - 2

'copy column 1 
worksheets("worksheet3").cells(p,1).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(q,1)

'copy column 2
worksheets("worksheet3").cells(p,2).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(q,2)

'copy column 3
worksheets("worksheet3").cells(p,3).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(q,3)

'copy column 4
worksheets("worksheet3").cells(p,4).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(q,4)

next q
next p

windows("data.xlsx").Activate
Sheets("Worksheet4").Activate

'dim copy worksheet 3
dim r as integer
dim s as integer

'no of rows on worksheet4
dim lr_p as long
lr_p = cells(rows.count,1).end(xlup).row

For r = 2 to lr_r

For s = (r+q) -2 to lr_r + q - 2

'copy column 1 
worksheets("worksheet4").cells(r,1).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(s,1)

'copy column 2
worksheets("worksheet4").cells(r,2).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(s,2)

'copy column 3
worksheets("worksheet4").cells(r,3).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(s,3)

'copy column 4
worksheets("worksheet4").cells(r,4).copy workbooks("newdata.xlsm").worksheets("sheet1").cells(s,4)

next s
next r

workbooks("data.xlsx").close

I tried changing:

For q = (p+z) -2 to lr_p + z - 2 

to include variants of x however this did not work as I need the code to function in both cases, if rows are populated or not.

Much tidier to copy/paste the whole block, and use a loop for the worksheets being copied:

Sub copyfile()

    Dim wb As Workbook, wbData As Workbook, i As Long, wsName, lr As Long, ws As Worksheet
    Dim pasteRow As Long
    
    Set wb = ThisWorkbook
    Set wbData = Workbooks.Open(Filename:=ThisWorkbook.Path & "\data.xlsx")
    
    pasteRow = 2  'start pasting here
    For Each wsName In Array("worksheet1", "worksheet2", "worksheet3", "worksheet4")
        Set ws = wbData.Worksheets(wsName)
        lr = LastOccupiedRow(ws)
        If lr > 1 Then    'any data from row 2 on?
            ws.Range("A2:D" & lr).copy wb.Worksheets("sheet1").Cells(pasteRow, "A")
            pasteRow = pasteRow + (lr - 1)
        End If
    Next wsName
    
    wbData.Close False
    
End Sub

Function LastOccupiedRow(ws As Worksheet) As Long
    Dim f As Range
    Set f = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not f Is Nothing Then LastOccupiedRow = f.Row
End Function