用于循环文件并将特定数据复制到一个文件的 Excel VBA 代码

Question

我是 VBA 新手，如果有人能提供帮助，我将不胜感激。我只需要以下代码中简单 VBA 循环的帮助。 我正在尝试遍历文件夹中的 excel 文件，并将所有文件中的源工作表中的特定数据复制到新工作簿（表 2）。我有一个代码可以完成 70% 的工作，但我很难挑选一些数据并以特定格式复制它。

    Option Explicit  

    Const FOLDER_PATH = "C:\Temp\" 'REMEMBER END BACKSLASH


    Sub ImportWorksheets() 
         '=============================================
         'Process all Excel files in specified folder
         '=============================================
        Dim sFile As String 'file to process
        Dim wsTarget As Worksheet 
        Dim wbSource As Workbook 
        Dim wsSource As Worksheet 

        Dim rowTarget As Long 'output row
            Dim FirstRow As Long, LastRow As Long
    FirstRow = 1
    LastRow = 5
   Dim RowRange As Range
        rowTarget = 2 

         'check the folder exists
        If Not FileFolderExists(FOLDER_PATH) Then 
            MsgBox "Specified folder does not exist, exiting!" 
            Exit Sub 
        End If 

         'reset application settings in event of error
        On Error Goto errHandler 
        Application.ScreenUpdating = False 

         'set up the target worksheet
        Set wsTarget = Sheets("Sheet2") 

         'loop through the Excel files in the folder
        sFile = Dir(FOLDER_PATH & "*.xls*") 
        Do Until sFile = "" 

             'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
            Set wbSource = Workbooks.Open(FOLDER_PATH & sFile) 
            Set wsSource = Sheets("DispForm") 'EDIT IF NECESSARY

             'import the data
     With wsTarget
     For Each rw In RowRange
         If wsSource.Cells(rw.Row, 1) & wsSource.Cells(rw.Row + 1, 1) = "" Then
         Exit For
         End If

           .Range("A" & rowTarget).Value = wsSource.Range("B1").Value
              .Range("B" & rowTarget).Value = wsSource.Cells(rw.Row, 2)

              .Range("C" & rowTarget).Value = wsSource.Cells(rw.Row, 4)

              .Range("D" & rowTarget).Value = sFile
               rowTarget = rowTarget + 1
         Next rw

    End With


             'close the source workbook, increment the output row and get the next file
            wbSource.Close SaveChanges:=False 
            rowTarget = rowTarget + 1 
            sFile = Dir() 
        Loop 

    errHandler: 
        On Error Resume Next 
        Application.ScreenUpdating = True 

         'tidy up
        Set wsSource = Nothing 
        Set wbSource = Nothing 
        Set wsTarget = Nothing 
    End Sub 




    Private Function FileFolderExists(strPath As String) As Boolean 
        If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True 
    End Function 

Answer 1

您只需从源文件中复制一行数据。所以你需要在文件循环中有一个循环来循环所有行，或者有一个范围来选择所有行。

尝试以下方法：

    Dim FirstRow As Long, LastRow As Long
    FirstRow = 9
    LastRow = 100

    Set rowRange = wsSource.Range("A" & FirstRow & ":A" & LastRow)

    With wsTarget
        For Each rw In rowRange
            If wsSource.Cells(rw.Row, 2) = "" Then
            Exit For
            End If

             .Range("A" & rowTarget).Value = wsSource.Cells(rw.Row, 2)
             .Range("B" & rowTarget).Value = wsSource.Cells(rw.Row, 3)
        Next rw
    End With