时间戳

首页 > 解决方案 > 搜索列名并复制数据

excel - 搜索列名并复制数据

问题描述

Workbook1 - Sheet 1:
Unique ID (Column D) | Line ID (Column Q) | Date1 (Column AL) | Date2 (Column AN) | Date3 (Column AO)| Date4 (Column AP)| Date5 (Column AQ)

Workbook 2 - Sheet 2: 
Unique ID (Column B) | Line ID (Column C) | Date1 (Column E) | Date2 (Column F) | Date3 (Column G)| Date4 (Column H)| Date5 (Column I)

我的第一个工作簿工作表中有 7 列，我想将它们复制到第二个工作簿工作表中的相应列。

我需要的列的列号可能会改变。因此，我不想通过诸如 w="B" 之类的列来声明变量。相反，我想搜索名称为“LineID”的列，如果名称与列名匹配，则将数据复制到另一个工作簿工作表中的列。

表 1 中的这些列不按顺序排列，因为它们之间有许多列。列的顺序也会根据输入数据的管理员而改变。所以我想用他们的名字搜索列并获取它下面的数据。然后将其复制到另一张纸上。

我通过指定要复制的每一列来复制数据，但如果列更改，我必须返回我的代码并更改列值。相反，如果该列由其标题标识，则会更容易。

我不擅长 VBA，非常感谢任何帮助解决这个问题。

标签： excelvba

解决方案

您可以将以下代码复制并粘贴到新模块中。它可以进入一个新的工作簿，或者你正在复制的任何一个工作簿。

如内联注释中所述，您需要更新 Set wsSrc 和 Set wsDest 行以匹配您的工作簿和工作表名称。

要使其无需进一步修改即可工作，您需要打开两个工作簿（从（源）复制的工作簿和粘贴到（目标）的工作簿）。此外，您的标题需要在第 1 行。

Option Explicit

Public Sub CopyData()

    ' DECLARE VARIABLES
    Dim i As Integer            ' Counter
    Dim j As Integer            ' Counter
    Dim colsSrc As Integer      ' Source worksheet columns
    Dim colsDest As Integer     ' Destination worksheet columns
    Dim rowsSrc As Long         ' Source worksheet rows excluding header
    Dim wsSrc As Worksheet      ' Source worksheet
    Dim wsDest As Worksheet     ' Destination worksheet
    
    ' SET VARIABLES
    Set wsSrc = Workbooks("Source.xlsx").Sheets("Sheet1")           ' Source worksheet (change Source.xlsx and Sheet1 to match your workbook name and worksheet name)
    Set wsDest = Workbooks("Destination.xlsx").Sheets("Sheet1")     ' Destination worksheet (change Destination.xlsx and Sheet1 to match your workbook name and worksheet name)
    colsSrc = wsSrc.Cells(1, Columns.Count).End(xlToLeft).Column    ' Source worksheet columns (assumes header is row 1)
    colsDest = wsDest.Cells(1, Columns.Count).End(xlToLeft).Column  ' Destination worksheet columns (assumes header is row 1)
    rowsSrc = wsSrc.Range("A1").CurrentRegion.Rows.Count - 1        ' Source worksheet rows excluding header (assumes header is row 1
    
    ' COPY DATA FROM SOURCE WORKSHEET TO DESTINATION WORKSHEET _
    - Compares each column header in your destination workbook to each column in your source workbook _
    - If a match is found, copies the column from the source workbook and pastes it into the destination workbook
    For i = 1 To colsDest
        For j = 1 To colsSrc
            If wsSrc.Cells(1, j) = wsDest.Cells(1, i) Then
                wsSrc.Cells(2, j).Resize(rowsSrc, 1).Copy wsDest.Cells(2, i)
                Exit For
            End If
        Next j
    Next i

End Sub

推荐阅读