循环复制数据切换工作表时如何消除自动新增的空行
解决多工作表合并时出现空行的问题
我帮你排查了下代码,循环切换工作表时出现空行的核心问题是目标单元格的行号计算错误——你当前用iWorksheetIndex + iRowCounter来定位目标行,这会让每个新工作表的起始行额外加上工作表的序号,导致和上一个工作表的最后一行之间出现间隙。
问题代码分析
原代码中目标行的计算逻辑:
wksTarget.Cells(iWorksheetIndex + iRowCounter, 1).PasteSpecial Paste:=xlPasteValues
比如第一个工作表处理完后,iRowCounter已经累计了该表的所有数据行数;第二个工作表的iWorksheetIndex是2,这时起始行就会变成2 + 累计行数,而第一个工作表的最后一行是1 + 累计行数-1,中间自然就空出了一行。
修正后的完整代码
Sub NewPivot() Dim iRow As Long, iWorksheetIndex As Long, iNumberOfWorksheets As Long, iRowCounter As Long, iCol As Long, lastCol As Long Dim wbkSource As Workbook Dim wksSource As Worksheet Dim wbkTarget As Workbook Dim wksTarget As Worksheet Dim targetRow As Long ' 新增变量专门记录目标行 ' 打开源工作簿并直接赋值,避免名称引用错误 Set wbkSource = Workbooks.Open("C:\Source.xlsm") ' 用Worksheets.Count统计工作表,排除图表等非工作表对象 iNumberOfWorksheets = wbkSource.Worksheets.Count ' 目标工作簿为当前运行代码的工作簿 Set wbkTarget = ThisWorkbook Set wksTarget = wbkTarget.Worksheets(1) iRowCounter = 0 For iWorksheetIndex = 1 To iNumberOfWorksheets Set wksSource = wbkSource.Worksheets(iWorksheetIndex) lastCol = wksSource.Cells(1, 1).End(xlToRight).Column For iCol = 0 To lastCol - 2 ' 遇到表头为"Sum"的列,直接跳过该列 If wksSource.Cells(1, 2 + iCol) = "Sum" Then Exit For End If For iRow = 2 To 5 targetRow = iRowCounter + 1 ' 直接用累计行数+1定位,确保数据连续 ' 直接赋值替代Copy/PasteSpecial,更高效且避免剪贴板问题 wksTarget.Cells(targetRow, 1).Value = wksSource.Cells(iRow, 2 + iCol).Value wksTarget.Cells(targetRow, 2).Value = wksSource.Cells(1, 2 + iCol).Value wksTarget.Cells(targetRow, 3).Value = wksSource.Cells(iRow, 1).Value iRowCounter = iRowCounter + 1 Next iRow Next iCol Next iWorksheetIndex ' 可选:清除剪贴板内容 Application.CutCopyMode = False End Sub
关键优化说明
- 修复空行问题:用
targetRow = iRowCounter + 1直接定位目标行,让数据连续写入,彻底消除空行。 - 提升运行效率:替换复制粘贴为单元格直接赋值,避免依赖剪贴板,运行速度更快且减少报错概率。
- 代码更严谨:用
wbkSource.Worksheets.Count统计工作表(排除图表、宏表等非工作表对象),提前绑定源工作表对象,减少重复引用的冗余。
修改后的数据会连续排列,完全可以直接用来创建数据透视表,不需要额外清理操作。
内容的提问来源于stack exchange,提问作者Questionairee
相关产品推荐
相关产品推荐

