Поиск нескольких заголовков столбцов, записанных в главном листе в строке 1 ИЗ других листов, чтобы скопировать целые столбцы

Question

В MasterSheet говорят, что у меня есть заголовки столбцов «Имена сотрудников», «CarType» и «DOB».Эти столбцы и данные их строк находятся на разных листах одной и той же книги.Мне нужна простая функция поиска в VBA для поиска нескольких заголовков столбцов и копирования по всему столбцу.Мне нужно, чтобы несколько столбцов в мастер-файле были заполнены следующим образом, поэтому необходима функция цикла.

Если заголовок не найден, оставьте строку пустой и перейдите к заголовку столбца в MasterSheet.

Заранее спасибо!Мой первый пост, и поэтому я не знаю, поможет ли приведенное выше объяснение.

Образец MasterSheet Sheet2, где один заголовок столбца равен

НижеБазовый код - это то, что я нашел, но он слишком простой и не проходит через Макро VBA для копирования столбца на основе заголовка и вставки в другой лист

Answer 1

Примерно так должно работать:

Sub MasterSheet()

    Dim wb As Workbook
    Dim newSht As Worksheet, Hdrs As Variant, i As Long, EdrisRange As Range

    Hdrs = Array("Heading 1", "Heading 2")

    Set wb = ActiveWorkbook

    Set newSht = wb.Worksheets.Add(after:=ActiveSheet)

    For i = LBound(Hdrs) To UBound(Hdrs)
        Set EdrisRange = FindHeaderInWorkbook(wb, CStr(Hdrs(i)), newSht)
        If Not EdrisRange Is Nothing Then
            Application.Intersect(EdrisRange.EntireColumn, EdrisRange.Parent.UsedRange).Copy _
                                                         Destination:=newSht.Cells(1, i + 1)
        End If
    Next i

    Application.CutCopyMode = False

End Sub

'find a header *HeaderText* in a workbook *wb*, excluding the sheet *excludeSheet*
Function FindHeaderInWorkbook(wb As Workbook, HeaderText As String, excludeSheet As Worksheet)
    Dim sht As Worksheet, rng As Range
    For Each sht In wb.Worksheets
        If sht.Name <> excludeSheet.Name Then
            Set rng = sht.Rows(1).Find(what:=HeaderText, lookat:=xlWhole)
            If Not rng Is Nothing Then Exit For
        End If
    Next sht
    Set FindHeaderInWorkbook = rng
End Function

Answer 2

Это то, что я имею до сих пор, но ограничения заключаются в том, что он просматривает по одному листу за раз, а поиск в заголовке не динамический.

Sub MasterSheet()

Dim newSht As Worksheet, sSht As Worksheet, Hdrs As Variant, i As Long, EdrisRange As 
Range
Set sSht = ActiveSheet
'Expand the array below to include all relevant column headers - I want the below 
line to be dynamic. Looking at multiple headers from the MasterSheet.
Hdrs = Array("Heading 1")
Application.ScreenUpdating = False
Set newSht = Worksheets.Add(after:=sSht)
With sSht.UsedRange.Rows(1)
    For i = LBound(Hdrs) To UBound(Hdrs)
        Set EdrisRange = .Find(Hdrs(i), lookat:=xlWhole)
        If Not EdrisRange Is Nothing Then
            Intersect(EdrisRange.EntireColumn, sSht.UsedRange).Copy 
Destination:=newSht.Cells(1, i + 1)
        End If
    Next i
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub