Excel VBA求助：批量复制指定范围后无法复制W157单元格

我来帮你搞定这个复制W157单元格的问题！你的代码里的核心错误在于错误地拼接了两个Range对象，导致Excel无法识别你要复制的第二个单元格。

问题分析 #

你原来的代码里这一行是错误的：

wb.Sheets(2).Range ("W7:W" & i + 5) & wb.Sheets(2).Range("W157").Copy

&是字符串连接运算符，它会把两个Range对象转换成单元格地址字符串（比如$W$7:$W$9和$W$157拼接成$W$7:$W$9$W$157），这根本不是一个有效的Excel单元格范围，所以Excel只会尝试复制第一个范围，W157完全没被纳入复制操作，再加上On Error Resume Next掩盖了错误，你就看不到问题出在哪。

解决方案：分两次复制粘贴（或合并Range） #

这里推荐两种可靠的实现方式，根据你的需求选择：

方式1：分两次复制，把W157内容追加到复制范围的下方

这种方式适合你希望W157的内容跟在批量复制的数据后面的场景：

Public Sub CommandButton2_Click()
 Dim i As Long
 Dim wb As Workbook
 Dim NewWB As Workbook
 Dim saveFile As String
 Dim lastRow As Long ' 新增变量用于定位粘贴位置
 
 ' 移除On Error Resume Next，方便调试错误
 i = Sheets(1).Range("B14").End(xlDown).Row - 13 '(start checking if any values from B15 downwards)
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Set wb = ActiveWorkbook
 Set NewWB = Application.Workbooks.Add
 Thispath = wb.path
 
 ' 第一步：复制批量范围到新表A1开始的位置
 wb.Sheets(2).Range("W7:W" & i + 5).Copy
 NewWB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
 
 ' 第二步：复制W157单元格，粘贴到批量数据的下一行
 wb.Sheets(2).Range("W157").Copy
 lastRow = NewWB.Worksheets(1).Cells(NewWB.Worksheets(1).Rows.Count, "A").End(xlUp).Row + 1
 NewWB.Worksheets(1).Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues
 
 NewWB.SaveAs filename:=Thispath & "\TEXTFILE.txt", FileFormat:=xlText, CreateBackup:=False
 NewWB.Close
 Application.CutCopyMode = False
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
End Sub

方式2：用Union合并两个Range，一次复制（保留原位置间隔）

如果你希望复制的内容保留W7:W(i+5)和W157在原表中的位置间隔（比如W157在原表是单独的行，粘贴后也空出对应行数），可以用Union方法合并两个Range：

Public Sub CommandButton2_Click()
 Dim i As Long
 Dim wb As Workbook
 Dim NewWB As Workbook
 Dim saveFile As String
 Dim copyRange As Range ' 新增变量存储合并后的范围
 
 ' 移除On Error Resume Next
 i = Sheets(1).Range("B14").End(xlDown).Row - 13 '(start checking if any values from B15 downwards)
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Set wb = ActiveWorkbook
 Set NewWB = Application.Workbooks.Add
 Thispath = wb.path
 
 ' 合并两个不连续的Range
 Set copyRange = Union(wb.Sheets(2).Range("W7:W" & i + 5), wb.Sheets(2).Range("W157"))
 copyRange.Copy
 NewWB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
 
 NewWB.SaveAs filename:=Thispath & "\TEXTFILE.txt", FileFormat:=xlText, CreateBackup:=False
 NewWB.Close
 Application.CutCopyMode = False
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
End Sub

额外提示 #

• 建议移除On Error Resume Next，它会掩盖代码中的潜在错误，不利于调试。如果担心某些操作可能出错，可以针对性地添加错误处理，而不是全局忽略。
• 你可以根据实际需求调整W157的粘贴位置，比如如果不想追加到下方，直接指定Range("A" & i + 1)也是可以的，但用End(xlUp)的方式更灵活，能适配批量数据行数变化的情况。

内容的提问来源于stack exchange，提问作者ADRSAL