Соответствующий столбец Match

Question

вывод должен выглядеть следующим образом

Я написал код, который берет исходный файл, копирует данные и вставляет их в основной файл.Но там где 3 разных рабочих тетради для данных.Теперь, благодаря новому поставщику, он предоставляет данные в одной книге, но в трех разных таблицах.Я подключил диапазон ячеек, и каждый раз мне приходилось менять диапазон ячеек в соответствии с данными, которые я хочу разместить в этой конкретной строке или столбце.Что требует времени для меня, чтобы сделать.Я хочу полностью автоматизировать его.

Call FillinData(sourceFile, destFile, "Bus", "B42:B53", "L", 10, 12) 

Приведенный выше формат, который я использовал.

Необработанные данные в формате Excel, а файл Excel имеет 3 листа.Я хотел бы скопировать эти данные в основной файл, который также имеет 3 листа.Таким образом, данные для sheet1 должны быть вставлены в sheet1 в основном файле.И так далее для оставшихся 3. Что я хотел бы сделать, чтобы мой код:

1) Выберите необработанные данные.

2) сравните столбцы мастер-файла и вставьте его.Я хотел бы, чтобы код искал правильное имя столбца в главном файле, а затем вставил значения в правильный столбец из необработанного файла.

Мой код здесь

Sub Values()

    Dim sourceFile As String
    Dim destFile As String

    Application.ScreenUpdating = False

    sourceFile = "C:\Users\Desktop\Source File Name"
    destFile = "C:\Users\Desktop\Dest File Name"

    Call FillinData(sourceFile, destFile, "Bus", "E57:E68", "D", 7, 12)

End Sub

Public Sub FillinData(ByVal Source As String, ByVal Dest As String, ByVal SheetName As String, ByVal sourceRange As String, ByVal destStartCellName As String, ByVal destStartCellNumber As Integer, ByVal count As String)

    Dim sourceData As Workbook
    Dim destData As Workbook

    Set sourceData = Workbooks.Open(Source)

    For Each C In ActiveSheet.Range(sourceRange)

        Set destData = Workbooks.Open(Dest)

        Worksheets(SheetName).Range(destStartCellName & destStartCellNumber) = C.Value

        destStartCellNumber = destStartCellNumber + 1

        destData.Save

        destData.Close

    Next C

    sourceData.Close

End Sub

Answer 1

Что-то похожее на этот пример должно работать для вас.

Sub CopyDest3()

Dim shtImp As Worksheet
Dim shtSrc As Worksheet
Dim wbs As Workbook
Dim wbd As Workbook
Dim k As Integer
Set wbd = ThisWorkbook
Set wbs = Workbooks("Source_1.xlsx") 'presuming workbook is open
Set shtImp = wbd.Sheets("Dest")
k = 1
For k = 1 To 2
Set shtSrc = wbs.Sheets(k)

'From Source to Dest
Dim rngImpTitles As Range
Set rngImpTitles = shtImp.Rows(1)
Dim rngImpNames As Range
Set rngImpNames = shtImp.Columns(1)

Dim CopyColumn As Long
Dim CopyRow As Long
Dim foundRow As Long
Dim foundCol As Long

On Error Resume Next
'for each column in row 1 of import sheet
For CopyColumn = 2 To shtSrc.Cells(1, shtSrc.Columns.count).End(xlToLeft).Column
    foundCol = rngImpTitles.Find(shtSrc.Cells(1, CopyColumn).Value2).Column
    If Err.Number <> 0 Then
        MsgBox "Not such a col title in importsheet for " & vbNewLine & _
                        shtSrc.Cells(1, CopyColumn)
        Err.Clear
        GoTo skip_title
    End If


    For CopyRow = 2 To shtSrc.Cells(shtSrc.Rows.count, 1).End(xlUp).Row
        foundRow = rngImpNames.Find(shtSrc.Cells(CopyRow, 1)).Row
        If Err.Number <> 0 Then
            MsgBox "Not such a row name in importsheet for " & vbNewLine & _
                        shtSrc.Cells(CopyRow, 1)
            Err.Clear
            GoTo skip_row
        End If

            If Len(shtSrc.Cells(CopyRow, CopyColumn)) <> 0 Then
                    shtSrc.Cells(CopyRow, CopyColumn).Copy shtImp.Cells(foundRow, foundCol)
            End If

skip_row:
    Next CopyRow
skip_title:
Next CopyColumn
Next k
End Sub