VBA to Copy Columns Using Headers but Ignore Columns without Data

Hi!

I use the following code to move data from one worksheet to another using column headers (see attached workbook). My issue is that if there isn't data in the column it copies the header into the second row.

Is it possible to ignore columns without data?

Sub Copy1()

    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Set ws = Worksheets("Sheet1")
    Set ws2 = Worksheets("Timesheet1")

        With ws
    
            For i = 1 To .UsedRange.Columns.Count
                Set x = ws2.Rows(4).Find(ws.Cells(1, i).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not x Is Nothing Then
                    y = .Cells(Rows.Count, i).End(3).Row
                    .Range(.Cells(2, i), .Cells(y, i)).Copy
                    ws2.Cells(5, x.Column).PasteSpecial xlValues
                End If
    
                Set x = Nothing
            Next i
        End With

End Sub

Thanks!!
Kate

Have not checked anything but noticed the period missing in front of Rows.
Does that make a difference?

y = .Cells(.Rows.Count, i).End(3).Row

Thanks for your help, Jolivanes! But the period doesn't change anything.

No, I don't want to hide the empty columns on the Timesheet1 tab. This file goes to payroll and they want to keep it all visible.

I could do a second bit of code that would delete non-numbers in that range. But I'd rather alter the code to account for it.

Sub Copy1()

Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Set ws = Worksheets("Sheet1")
    Set ws2 = Worksheets("Timesheet1")

        With ws
    
            For i = 1 To .UsedRange.Columns.Count
                Set x = ws2.Rows(4).Find(ws.Cells(1, i).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not x Is Nothing Then
                V = ws.Cells(1, i)
                    Y = .Cells(Rows.Count, i).End(3).Row
                    If Y > 1 Then
                        .Range(.Cells(2, i), .Cells(Y, i)).Copy
                        ws2.Cells(5, x.Column).PasteSpecial xlValues
                    End If
                End If
    
                Set x = Nothing
            Next i
        End With

End Sub

AB33, that worked perfectly!! You are awesome!