根据列标题名称将特定列从一个 excel 复制到另一个 excel答案

【问题标题】：specific columns copy from one excel to another excel based on column header name根据列标题名称将特定列从一个 excel 复制到另一个 excel
【发布时间】：2019-03-07 04:33:29
【问题描述】：

我想根据列标题名称将列从一个 excel 复制到另一个 excel。我有两个名为“Source”和“Destination”的 excel 文件，如下图所示：

Source.xls

Destination.xls

我想复制源文件中的所有列并粘贴到基于头文件的目标 excel 文件中，即黄色阴影列。因为在目标文件中定义了一些公式，如图所示，它计算源文件列中的值。

我已经尝试了基本的复制和粘贴列。虽然它有效，但它需要大量的人工干预。

示例代码：

src.Range("A:A").Copy Destination:=trg.Range("A1")

src.Range("B:B").Copy Destination:=trg.Range("E1")

src.Range("C:C").Copy Destination:=trg.Range("I1")

我希望从源文件和目标文件中查找列标题名称，如果名称匹配，则它将整个列粘贴到目标文件中。由于我对 excel 很陌生，任何人都可以通过 VBA 脚本帮助解决这个问题

【问题讨论】：

标签： excel vba

【解决方案1】：

请试试这个。

Option Explicit

Public Sub SpecificColCopy()
    Dim Wbs As Workbook
    Dim Wbd As Workbook
    Dim Wbm As Workbook
    Dim RealLastRow As Long
    Dim SourceCol As Long
    Dim Cell As Range
    Dim sourceWS As Worksheet, targetWS As Worksheet
    Dim MacroWS As Worksheet
    Dim SourceHeaderRow As Long: SourceHeaderRow = 1
    Dim SourceCell As Range
    Dim TargetHeader As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    Set Wbm = ThisWorkbook
    Set MacroWS = Wbm.Worksheets("Sheet1")

    Set Wbs = Workbooks.Open("C:\mydirb\Source.xlsx") 'workbook needs to be closed state
    Set sourceWS = Wbs.Worksheets("Sheet1")

    Set Wbd = Workbooks.Open("C:\mydirb\Destination.xlsx") ''workbook needs to be closed state
    Set targetWS = Wbd.Worksheets("Sheet1")
    Set TargetHeader = targetWS.Range("A1:N1")
    On Error GoTo 0

    sourceWS.Activate
    For Each Cell In TargetHeader
        If Cell.Value <> "" Then
            Set SourceCell = Rows(SourceHeaderRow).Find _
                (Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not SourceCell Is Nothing Then
                SourceCol = SourceCell.Column
                RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If RealLastRow > SourceHeaderRow Then
                    Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
                        SourceCol)).Copy
                    targetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
                End If
            End If
        End If
    Next


  MacroWS.Activate
  Wbs.Save
  Wbd.Save
  Wbs.Close
  Wbd.Close
  Application.DisplayAlerts = True
End Sub

 [![Souce_destination][1]][1]

【讨论】：

@suresh 很高兴它对您有用。请接受我的回答。要将答案标记为已接受，请单击下方三角形下方答案旁边的复选标记，将其从灰色切换为填充在。