Excel VBA 分别复制表格中的每一行

Question

我现在意识到我原来的组织方法不够用，所以我想将所有信息添加到一个名为 ("RAW") 的新工作表中

我正在尝试创建一个基于表格行数的循环。在这里，我从一个“theFILE.xlsm”循环，它一次打开一个工作簿。当工作簿打开时我想复制

这是我想做的：

• 打开工作簿 (sFile)，
• 统计 Table2 的 databodyrange.count，
• 将计数分配给名为 BodyCount 的变量，
• 复制并粘贴所需的行，
• 循环获取 BodyCount 的次数

将打开的每个工作簿都有一个 Table2，但没有一个表完成，所以我不能像第一个 Do While 循环那样依赖单元格是否为 ""。

如何创建循环以根据表中的行数一次复制 1 行。

这是什么

Sub every_one() ''compile everything into 1 list

''''DIMENSIONS
Application.ScreenUpdating = False

Dim SourceRow As Long
Dim sFile As String
Dim wb As Workbook
Dim FileName1 As String
Dim FileName2 As String
Dim wksSource As Worksheet
Const scWkbSourceName As String = "theFILE.xlsm"

Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1")

Const wsOriginalBook As String = "theFILE.xlsm"
Const sPath As String = "U:\theFILES\" 

SourceRow = 5
DestinationColumn = 2
FirstDestinationRow = 1
SecondDestinationRow = 41

''ENSURE SELECT SOURCE SHEET
Sheets("Sheet1").Select

Do While Cells(SourceRow, "C").Value <> ""

    FileName1 = wksSource.Range("A" & SourceRow).Value
    FileName2 = wksSource.Range("L" & SourceRow).Value

    sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm"

    ''OPEN FILE
    Set wb = Workbooks.Open(sFile)

''insert CODE TO LOOP

    ''DECLARE TABLE
    Dim tbl As ListObject
    Dim BodyCount As Long
    Dim StartingTablePosition As Long

    Set tbl = ActiveSheet.ListObjects("Table2")

    'start FOR, LOOP
    BodyCount = ActiveSheet.ListObjects("Table2").DataBodyRange.Rows.Count
    Dim WorkingRow As Long
    WorkingRow = 20

    For i = WorkingRow to WorkingRow + BodyCount Step 1

        'COPY "SourceRow" from "theFILE.xlsm"
    Windows("theFILE.xlsm").Activate
    Rows(SourceRow).Copy
        'PASTE to Compile Sheet, next available column & TRANSPOSE row into column
    Sheets("RAW").Cells.Item(FirstDestinationRow, DestinationColumn).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True 
    
        'COPY ROW from "sFile" Table2
    wb.Activate
    Rows(WorkingRow).Copy
    Application.CutCopyMode = False
        'PASTE to Compile sheet, TRANSPOSE row into column
    Windows("theFILE 1.1.xlsm").Activate
    ActiveSheet.Cells.Item(SecondDestinationRow, DestinationColumn).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

    DestinationColumn = DestinationColumn + 1

    Next i

''End custom code for desired loop operation

''CLOSE WORKBOOK W/O BEFORE SAVE
wb.Activate
Application.EnableEvents = False
ActiveWorkbook.Save
Application.EnableEvents = True
ActiveWorkbook.Close savechanges:=False

Windows("theFILE.xlsm").Activate
Sheets("Sheet1").Select

''GO TO NEXT .xlsm FILE
SourceRow = SourceRow + 1

Loop

End Sub

我是 For...Next 循环的新手。任何和所有提示、技巧或提示将不胜感激。

这里有一些图片，

Answer 1

我尝试按照您的代码进行操作，但最终以某种方式纠结...

我的代码假设：

• Sheet1（文件名所在的位置）中有一个 Excel 表格，我将其命名为 BaseTable
• 您正在具有该表的工作簿中运行宏
• 您的目标工作表“RAW”在您运行宏的同一工作簿中
• 您的外部工作簿在第一张表中有 Table2

建议：

• 在尝试此代码之前为您的文件和数据创建backup
• 按 F8 单步调试代码并根据需要进行调整
• 查看您的代码：
  • 尽量避免使用select和activatesee this answer
  • 尝试将输入与其他语句分开（将它们分配给variables）
  • Indent 你的代码（This plugin 有一个很棒的功能）
  • 在代码开头使用Option Explicit (read this article)

代码：

Option Explicit


Public Sub Process()

    Dim baseTable As ListObject
    Dim baseTableRow As ListRow
    Dim baseTableName As String

    Dim targetSheet As Worksheet
    Dim targetSheetName As String
    Dim targetFirstRow As Long
    Dim targetColumnCounter As Long

    Dim externalWorkbook As Workbook
    Dim externalTable As ListObject
    Dim externalTableName As String
    Dim externalTableRow As ListRow

    Dim externalFilePath As String
    Dim externalBasePath As String
    Dim externalFileExtension As String
    Dim externalFolderName As String
    Dim externalFileName As String



    ' Adjust the following parameters to fit your needs
    baseTableName = "BaseTable"
    targetSheetName = "RAW"
    externalBasePath = "U:\theFILES\"
    externalFileExtension = "xlsm"
    externalTableName = "Table2"

    targetFirstRow = 1
    targetColumnCounter = 2 ' Column in which the rows will begin being copied/transposed

    ' Initialize objects
    Set baseTable = Range(baseTableName).ListObject '-> This is the table in the "theFILE.xlsm" in "Sheet1" that's holding the file names

    Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)

    ' Loop through each row in the base table
    For Each baseTableRow In baseTable.ListRows

        ' Check if column C is not empty and has a valid file name -Cells(3) is equal to column C if table begins in column A-
        If baseTableRow.Range.Cells(3).Value <> vbNullString Then

            ' Get the folder (or partial path) from column A -Cells(1)-
            externalFolderName = baseTableRow.Range.Cells(1).Value

            ' Get the file name with extension from column L - Cells(12)
            externalFileName = baseTableRow.Range.Cells(12).Value

            ' Build the path to the file
            externalFilePath = externalBasePath & externalFolderName & "\" & externalFileName & "." & externalFileExtension

            ' Validate if file exists
            If Len(Dir(externalFilePath)) = 0 Then
                MsgBox "The file: " & externalFilePath & " does not exist"
            Else
                ' Open the file
                Set externalWorkbook = Workbooks.Open(externalFilePath)

                ' Reference the table in the external workbook (looks in the first worksheet -Worksheets(1)-) (ideally you'd check if the table exists)
                Set externalTable = externalWorkbook.Worksheets(1).ListObjects(externalTableName)

                ' Loop through each row in the external table (except header, and total)
                For Each externalTableRow In externalTable.ListRows

                    ' You'd probably do some validation here...
                    If externalTableRow.Range.Cells(1).Value <> vbNullString Then

                        ' Copy the list row
                        externalTableRow.Range.Copy

                        ' Paste it in the target sheet, transposed
                        targetSheet.Cells(targetFirstRow, targetColumnCounter).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                                                                                              False, Transpose:=True

                        targetColumnCounter = targetColumnCounter + 1

                    End If

                Next externalTableRow

                ' Close the file without saving changes
                externalWorkbook.Close False
            End If

        End If

    Next baseTableRow

End Sub

让我知道它是否有效！