excel - 如何使用 VBA 在 Excel 中查找特定列并复制粘贴相应的列

Question

我正在尝试在 Excel 中自动执行一项任务，在该任务中我需要自动复制和粘贴某些列并将我们的数据填充到单独的数据表文件中。我有阅读多个 Excel 文件和提取数据以及复制粘贴的基本代码。应该很容易，但每个文件中都有特定的必需数据列，但在同一索引中找不到它们。

如果您看到上图，您将看到不同的项目名称。复制/粘贴所需的数据由其文件名决定。我想要发生的事情是以引用文件名的方式运行代码，然后查找列以查找要复制的列，然后将其粘贴到数据表中。如何设置代码以这种方式运行？

代码如下：

    Private Const sPath As String = "C:\Users\angj2339\Documents\SSE\New folder\New folder\" 'DIRECTORY PATH

Sub LoopThroughFiles()

Dim sFile As String 'File Name
Dim sExt As String 'File extension you wish to open

    sExt = "xlsm" 'Change this if extension is different

    'loop through each file name and open it if the extension is correct
    sFile = Dir(sPath)
    Do Until sFile = ""
        If Right(sFile, 4) = sExt Then GetInfo sFile
        sFile = Dir
    Loop


End Sub

Private Sub GetInfo(sFile As String)

Dim wbFrom As Workbook 'workbook to copy the data from
Dim iRow As Integer 'row number of next empty row

 On Error GoTo errHandle

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set wbFrom = Workbooks.Open(sPath & sFile)


        wbFrom.Sheets("HighLevelDetail").Range("H4:BQ120").Copy 'Copy H4:BQ120
        iRow = Me.Range("A" & Rows.Count).End(xlUp).Row + 1 'Get an empty row in this workbook
        Me.Range("A" & iRow).PasteSpecial xlPasteValues 'past copied cells
        wbFrom.Close (False)

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Set wbFrom = Nothing

Exit Sub
errHandle:
MsgBox Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

如果问题的某些部分没有意义，我将很乐意提供更多细节或澄清。

标签： excelvba