VBA插入表单名称在每个循环

我有一本超过50张的工作簿。 每张纸的行数和列数完全相同（每个月的数据是一张纸）。 我正在使用“For Each”循环来复制每个工作表中的一系列单元格，并粘贴到“汇总”工作表中。 然后我删除空行。 如何在For Each Loop期间在单独的列中添加工作表名称。 我想知道一张纸上的数据开始和结束的位置。

Sub CopyRangeToAnotherSheet() Dim wks As Worksheet For Each wks In ThisWorkbook.Worksheets If Not wks.Name = "Summary" Then wks.Range("C1:J100" & wks.Cells(Rows.Count, "C").End(xlUp).Row).Copy_ Destination:=Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(0) End If Next Application.CutCopyMode = False End Sub Sub DeleteEmptyRows() Application.ScreenUpdating = False Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Application.ScreenUpdating = True End Sub 

数据

 Col ABCD Value1, Value2, Value3, Sheet Name Here Value1, Value2, Value3, Sheet Name Here Value1, Value2, Value3, Sheet Name Here 

Answer 1

试试这样的，我已经做了一些修改，使代码更清晰一点：

 Sub CopyRangeToAnotherSheet() Dim wks As Worksheet Dim copyRange as Range Dim destRange as Range For Each wks In ThisWorkbook.Worksheets If Not wks.Name = "Summary" Then '## Get the range which will be copied: Set copyRange = wks.Range("C1:J100" & wks.Cells(Rows.Count, "C").End(xlUp).Row) '## Get the range where you will paste: Set destRange = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(0) '## Copy/Paste: copyRange.Copy destRange '## Fill in the source worksheet (copyRange.Parent) sheet name destRange.Offset(0,3).Resize(copyRange.Rows.Count).Value = wks.Name End If Next Application.CutCopyMode = False End Sub