在下一个可用行上使用 vba 循环剪切和粘贴

Question

我是 vba 新手，但我认为这是解决我的问题的最佳方法。我需要从多个工作表 L1:L7(400+) 复制特定范围的数据并将其粘贴到摘要工作表 L2:R2 上。我必须在粘贴数据时转置数据，并将每组新数据复制到下一个可用行。我看过很多视频和阅读文章，但似乎都没有提供完整的解决方案。

当我尝试创建一个循环并尝试让它到达下一行时，它不起作用。它似乎总是卡在同一个“范围（“L2”）。PasteSpecial Transpose：True”的地方。它从“ActiveSheet.Select”单独工作，因此仅适用于一张纸和一行。下面是我尝试的最后一个循环组合。

任何帮助将不胜感激！

Sub CopyData()
    
    Dim sheet As Worksheet
    
    For Each sheet In ThisWorkbook.Sheets
        If sheet.Name <> "Summary" Then
            ActiveSheet.Select
            Range("L1:L7").Copy
            Sheets("Summary").Select
            Range("L2").PasteSpecial Transpose:=True
        End If
    Next
End Sub

Answer 1

正如@BigBen 所评论的，你关于让它总是在 L2 上粘贴相同数据的问题源于：

1. 忽略循环 sheet 并仅在 ActiveSheet 上工作
2. 硬编码单元格引用而不使用动态 LastRow 引用

以下是修正这两项后的样子：

Sub CopyData()
    
    Dim sheet As Worksheet, nextRng As Range
    
    For Each sheet In ThisWorkbook.Sheets
        If sheet.Name <> "Summary" Then
            sheet.Range("L1:L7").Copy
            
            'Finding the next open range to paste the data
            With Sheets("Summary")
                Set nextRng = .Range("L" & .Rows(.UsedRange.Rows.Count + .UsedRange.Row).Row)
            End With
            
            nextRng.PasteSpecial Transpose:=True
        End If
    Next

End Sub

替代 NextRng 公式：

With Sheets("Summary")
    Set nextRng = .Cells(.Cells(.Rows.Count, 12).End(xlUp).Row + 1, 12)
End With