Unable to Paste a column except 1st row in different excel workbook using excel vba

Question

I am trying to do simple copy paste task of a range. I am looking for a match of header in two excel sheets and when match occur I am trying to copy that column except 1st row to the different excel with same sheet name. I am able to copy paste complete column but I don't want to copy 1st row which is header. Please advice

Set Wb1 = Workbooks(Wb1name)
Sheetname = Wb1.ActiveSheet.Name

Set Wb2 = Workbooks("Worksheet2.xlsm")


'Find the last non-blank cell in row 1
l1Col = Wb1.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l1Row = Wb1.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row
l2Col = Wb2.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l2Row = Wb2.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To l1Col
    For j = 1 To l2Col
        If "       " & Wb1.Worksheets(Sheetname).Cells(1, i).Value = Wb2.Worksheets(Sheetname).Cells(1, j).Value Then

            '''If header matches in both excels then copy column to destination excel'''
             'This is working but entire column copied
             Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)
            '' This dosent work
            'Wb2.Worksheets(Sheetname).Range(Cells(2, j), Cells(l2Row, j)).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Cells(2, i), Cells(l1Row, i)) 


        End If
    Next j
Next i

Answer 1

您必须粘贴到单元格/范围，并且由于要复制整个列，因此必须将其粘贴到目标列的第一行。

Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Cells(1, i)

Answer 2

Change:

Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)

To:

Wb2.Worksheets(Sheetname).Range(Chr(j + 64) & "2:" & Chr(j + 64) & Wb2.Cells(Wb2.Rows.Count, "C").End(xlUp).Row).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Chr(i + 64) & "2")