时间戳

首页 > 解决方案 > 无法使用 excel vba 在不同的 excel 工作簿中粘贴除第一行之外的列

excel - 无法使用 excel vba 在不同的 excel 工作簿中粘贴除第一行之外的列

问题描述

我正在尝试执行一个范围的简单复制粘贴任务。我正在寻找两个 excel 表中的标题匹配，当匹配发生时，我试图将除第一行之外的列复制到具有相同工作表名称的不同 excel 中。我可以复制粘贴完整列，但我不想复制作为标题的第一行。请指教

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

标签： excelvba

解决方案

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

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

推荐阅读