Блог

Я хочу скопировать столбцы из одного Excel в другой Excel на основе имени заголовка столбца. у меня есть два файла Excel с именами «Source» и «Destination», как показано ниже на изображении:

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

Пожалуйста, попробуйте это.

 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:mydirbSource.xlsx") 'workbook needs to be closed state
    Set sourceWS = Wbs.Worksheets("Sheet1")

    Set Wbd = Workbooks.Open("C:mydirbDestination.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]