Транспонирование строк в столбцы после сопоставления того, что доступно

Question

Подобно этому посту, но немного другое: здесь Благодаря информации от @RetiredGeek Hope, это имеет смысл; Мне нужна помощь, чтобы что-то понять. Вот вопрос: я получаю данные из Интернета в виде нескольких таблиц, двух столбцов и 60 строк. Один столбец содержит заголовок, а строки содержат данные. Однако значения в первом столбце, представляющем заголовки, изменяются, и они не совпадают каждый день. Соответственно изменяются и данные в строках. Я хотел бы скопировать определенные заголовки из первого столбца на другой лист и динамически вытащить соответствующие значения строки. Ниже у меня есть три столбца - 3 примера - заголовков, которые показывают, какими будут заголовки в данный день. Один заголовок в определенный день. Я хотел бы, чтобы код проверял эти три столбца, совпадал с тем, что доступно из загруженных данных, которые соответствуют одному из трех столбцов.Затем скопируйте соответствующий столбец и перенесите его на отдельный лист, затем скопируйте совпадающие данные, которые теперь будут строками, и переместите их на одну строку ниже:

Sub CopyandTranspose()

 Dim wksSht1 As Worksheet
   Dim wksSht2 As Worksheet
   Dim wksSht4 As Worksheet
   Dim rngHdr  As Range
   Dim lMatch  As Long


Dim lColCnt As Long
   Dim lrow2 As Long
   Set wksSht1 = Worksheets("Sheet1")
   Set wksSht2 = Worksheets("Sheet2")
   Set wksSht4 = Worksheets("Sheet4")

' wksSht2.Activate
Set rngHdr = Nothing


   lColCnt = 1
  ' Lrow = 2

 'Set rngHdr = wksSht2.Cells(1, lColCnt)
 Set rngHdr = ActiveSheet.Cells(1, lColCnt)
   
   
   Do
   On Error Resume Next
     lMatch = Application.Match(rngHdr.value, wksSht1.Columns(1), 0)
    
     Range(wksSht1.Cells(lMatch, 1), wksSht1.Cells(lMatch, 1).Offset(0, 1)).Copy
  
     rngHdr.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
                         SkipBlanks:=False, Transpose:=True
'*** Move to next Header column ***
     lColCnt = lColCnt + 1
 'Set rngHdr = wksSht2.Cells(1, lColCnt)
 Set rngHdr = ActiveSheet.Cells(1, lColCnt)
       ' Application.Wait Now + TimeValue("00:00:01")
    Loop While rngHdr <> ""
END sub