VBA重命名工作表、复制转置数据失败（错误1004）求助

问题原因分析 #

1. 第一段代码报错原因：
   新增工作表后，Range("A3:BB150")未指定父工作表，此时ActiveSheet是新创建的空白工作表，复制的是空区域，转置后与目标区域A3:BB150大小完全不匹配，触发1004错误。

2. 第二段代码仅在Download表运行正常的原因：
   当在Download表运行时，Range("A3:BB150")默认指向当前激活的Download表，能正确获取源数据；在其他表运行时，Range指向当前激活的非Download表，复制的不是目标数据区域，转置后自然和目标区域大小不匹配。

修正方案（最佳实践） #

避免使用Select/Activate，直接用变量引用工作表，明确指定每个Range的父对象，彻底消除对ActiveSheet的依赖：

完整修正代码

Dim downloadSheet As Worksheet
Dim newSheet As Worksheet

' 重命名原Sheet1为Download并获取引用
Set downloadSheet = ThisWorkbook.Sheets("Sheet1")
downloadSheet.Name = "Download"

' 新增工作表并设置引用（新表自动命名为Sheet1）
Set newSheet = ThisWorkbook.Sheets.Add(After:=downloadSheet)

' 复制A1:A2到新表
downloadSheet.Range("A1:A2").Copy Destination:=newSheet.Range("A1:A2")

' 复制并转置A3:BB150到新表（仅指定起始单元格，Excel自动适配转置后区域）
downloadSheet.Range("A3:BB150").Copy
newSheet.Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

' 清除剪贴板，避免弹窗干扰
Application.CutCopyMode = False

针对第二段代码的修正

Dim downloadSheet As Worksheet
Dim targetSheet As Worksheet

' 明确指定工作表引用
Set downloadSheet = ThisWorkbook.Sheets("Download")
Set targetSheet = ThisWorkbook.Sheets("Sheet1")

' 复制A1:A2
downloadSheet.Range("A1:A2").Copy Destination:=targetSheet.Range("A1:A2")

' 复制并转置（指定父工作表，不受当前激活表影响）
downloadSheet.Range("A3:BB150").Copy
targetSheet.Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Application.CutCopyMode = False

关键要点 #

• 始终为Range对象指定父工作表，避免隐式依赖ActiveSheet，这是VBA编写的核心规范。
• 转置粘贴时，只需指定目标区域的起始单元格，Excel会自动根据转置后的区域大小填充，无需手动匹配原区域尺寸，从根源解决大小不匹配问题。

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