根据列标题将数据从一个工作簿转移到另一个工作簿

我下面的代码将列值从一个特定工作簿（Activeworkbook - 列 O、AH 和 I）转置到另一个工作簿（“loader file.xls” - 列 A、B、C）。它非常适合我的需求

Sub PullTrackerInfo()
'Pull info from respective column into correct column on loader file

Dim wb_mth As Workbook, wb_charges As Workbook, mapFromColumn As Variant, mapToColumn As Variant
    Dim lastCell As Integer, i As Integer, nextCell As Integer, arrCopy As Variant
Set wb_mth = ActiveWorkbook
Set wb_charges = Workbooks("loader file.xls")
    

    mapFromColumn = Array("O", "AH", "I")
    mapToColumn = Array("A", "B", "C")

        For i = 0 To UBound(mapFromColumn)

            With wb_mth.Sheets(1)

                lastCell = w.Sheets("owssvr").ListObjects("Table_owssvr").Range.Rows.Count
                arrCopy = .Range(mapFromColumn(i) & 2 & ":" & mapFromColumn(i) & lastCell)

            End With

            With wb_charges.Worksheets(1)

                nextCell = .Range(mapToColumn(i) & .Rows.Count).End(xlUp).Row + 1
                .Range(mapToColumn(i) & nextCell).Resize(UBound(arrCopy), UBound(arrCopy, 2)).Value = arrCopy

            End With
        Next i

End Sub

我想做的是更进一步，我通常必须将数据排序到正确的列，以便将其转置到加载程序文件。我想做的是根据列标题的标题（“市场代码、“ID”、“C 代码”）移动列数据。请参阅下面的想法...

mapFromColumn = Array("Market Code", "ID", "C Code",
    mapToColumn = Array("A", "B", "C")

        For i = 0 To UBound(mapFromColumn)

            With wb_mth.Sheets(1)

                lastCell = w.Sheets("owssvr").ListObjects("Table_owssvr").Range.Rows.Count
                arrCopy = .Range(mapFromColumn(i) & 2 & ":" & mapFromColumn(i) & lastCell)

            End With

            With wb_charges.Worksheets(1)

                nextCell = .Range(mapToColumn(i) & .Rows.Count).End(xlUp).Row + 1
                .Range(mapToColumn(i) & nextCell).Resize(UBound(arrCopy), UBound(arrCopy, 2)).Value = arrCopy

            End With
        Next i

End Sub

上面的代码显然不起作用，我尝试了几种不同的策略但无济于事。如果有人能帮助我那就太好了。谢谢

将重新排列的 listobject 列写入目标

这种方法使用

• 一个相当不为人知的特征Application.Match()得到所有列号各个标头的数量at once通过比较两个数组（假设现有标头，否则需要额外的错误处理）以及
• 的高级功能Application.Index() to 改编基于找到的整个列表框数据集数字列 values （而行值完全采用且顺序不变）.

Function getCols(individualHeaders, myTable As ListObject)
'Note: assumes existing header names & listobject start in column A
    'get all headers of list object
    Dim allHeaders
    allHeaders = Application.Transpose(myTable.HeaderRowRange.Value2)
    'get column numbers of found headers
    Dim cols
    cols = Application.Match(individualHeaders, allHeaders, 0)  ' 1-based
    ReDim Preserve cols(0 To UBound(cols) - 1)                  ' optional zero-base redim
    'return found numeric results
    getCols = cols
End Function

示例代码

虽然 OP 中有一些未声明的工作表引用，但这应该有效并解决您的问题

'[0]set listobject to memory
    Dim lob As ListObject
    Set lob = w.Sheets("owssvr").ListObjects("Table_owssvr")
'[1]get column numbers
    Dim mapFromColumn As Variant
    mapFromColumn = Array("Market Code", "ID", "C Code")
    mapFromColumn = getCols(mapFromColumn, lob)
    ' Debug.Print Join(mapFromColumn, ",")
'[2]get complete set of listobject data
    Dim data As Variant
    data = lob.DataBodyRange.Value2
'[3]limit data set to chosen columns in subsequent order
    data = Application.Index(data, Evaluate("row(1:" & UBound(data) & ")"), mapFromColumn)
'[4]write data to target
    Dim wb_charges As Workbook
    Set wb_charges = Workbooks("loader file.xls")
    With wb_charges.Worksheets(1)
        Dim nextCell As Long
        nextCell = .Range("A" & .Rows.Count).End(xlUp).Row + 1 
        .Range("A" & nextCell).Resize(UBound(data), UBound(data, 2)).Value = data
    End With

相关链接

• 的一些特点Application.Index()功能 https://stackoverflow.com/questions/51688593/excel-vba-insert-new-first-column-in-datafield-array-without-loops-or-api-call/51714153#51714153