VBA Excel：从多区域批量复制数据并粘贴至新建工作簿指定区域

问题说明 #

需要从旧工作簿复制6个数据源（1个单元格区域+5个单个单元格）到新建工作簿的指定位置，当前仅第一个区域复制成功：

• 使用PasteSpecial xlPasteValues粘贴第二个区域时，报错：Method 'PasteSpecial' of object' _Worksheet' failed
• 使用.Paste则仅粘贴公式，而非值

附当前代码：

Sub Generator1()
Dim wkd As Workbook, mwkt As Workbook
Dim ms As Worksheet, tw As Worksheet
Dim asbrng As Range, pianoi1 As Range, pianoi2 As Range, pianoi3 As Range, pianoi4 As Range, asset As Range

Set mwkt = ThisWorkbook
Set tw = mwkt.Sheets("Build Complete Photos1")

Set asbrng = tw.Range("M15:P41")
Set pianoi1 = tw.Range("F121")
Set pianoi2 = tw.Range("F122")
Set pianoi3 = tw.Range("F123")
Set pianoi4 = tw.Range("F124")
Set asset = tw.Range("E129")

asbrng.Copy
pianoi1.Copy

Set wkd = Workbooks.Add

With wkd
Application.DisplayAlerts = False
'SaveAs.Filename:="test"
Sheets("Sheet1").Name = "1"
.Sheets("1").HPageBreaks.Add Before:=Worksheets("1").Rows(42)
.Sheets("1").VPageBreaks.Add Before:=Worksheets("1").Columns(13)
Application.DisplayAlerts = True
Set ms = .Sheets("1")
With ms
'PROVIDING DATA FROM MAJOR ASBUILT DOCUMENT
    .Range("I3:L29").Select
    .Paste
    .Range("F36").Select
    .PasteSpecial xlPasteValues

错误原因 #

1. 连续执行asbrng.Copy和pianoi1.Copy后，剪贴板仅保留最后一次复制的内容（pianoi1），导致第一个粘贴操作实际粘贴的是pianoi1而非asbrng
2. .PasteSpecial需要调用在Range对象上，而非Worksheet，原代码中.PasteSpecial是对Worksheet操作，语法错误
3. 使用Select会降低代码稳定性，且容易引发剪贴板相关问题

解决方案 #

方案1：逐个复制粘贴（针对区域+单个单元格） #

避免连续复制，复制一个立即粘贴一个；单个单元格直接赋值更高效，无需复制粘贴：

Sub Generator1()
Dim wkd As Workbook, mwkt As Workbook
Dim ms As Worksheet, tw As Worksheet
Dim asbrng As Range, pianoi1 As Range, pianoi2 As Range, pianoi3 As Range, pianoi4 As Range, asset As Range

Set mwkt = ThisWorkbook
Set tw = mwkt.Sheets("Build Complete Photos1")

' 定义数据源
Set asbrng = tw.Range("M15:P41")
Set pianoi1 = tw.Range("F121")
Set pianoi2 = tw.Range("F122")
Set pianoi3 = tw.Range("F123")
Set pianoi4 = tw.Range("F124")
Set asset = tw.Range("E129")

' 新建工作簿
Set wkd = Workbooks.Add
With wkd
    Application.DisplayAlerts = False
    Sheets("Sheet1").Name = "1"
    .Sheets("1").HPageBreaks.Add Before:=.Sheets("1").Rows(42)
    .Sheets("1").VPageBreaks.Add Before:=.Sheets("1").Columns(13)
    Application.DisplayAlerts = True
    Set ms = .Sheets("1")
End With

' 粘贴单元格区域（保留格式/值，按需选择）
asbrng.Copy
ms.Range("I3:L29").PasteSpecial xlPasteValuesAndNumberFormats ' 可替换为xlPasteAll等参数

' 单个单元格直接赋值（高效且无剪贴板问题）
ms.Range("F36").Value = pianoi1.Value
ms.Range("F37").Value = pianoi2.Value ' 假设目标位置，可自行修改
ms.Range("F38").Value = pianoi3.Value
ms.Range("F39").Value = pianoi4.Value
ms.Range("XX").Value = asset.Value ' 替换为实际目标位置

' 清除剪贴板，避免影响后续操作
Application.CutCopyMode = False
End Sub

方案2：批量处理（适合扩展更多数据源） #

用数组存储数据源和对应目标位置，循环处理，更易维护：

Sub Generator_Batch()
Dim wkd As Workbook, mwkt As Workbook
Dim ms As Worksheet, tw As Worksheet
Dim dataPairs As Variant
Dim i As Integer

Set mwkt = ThisWorkbook
Set tw = mwkt.Sheets("Build Complete Photos1")

' 定义数据源-目标位置对：数组格式为 {数据源区域, 目标区域}
dataPairs = Array( _
    Array(tw.Range("M15:P41"), "I3:L29"), _
    Array(tw.Range("F121"), "F36"), _
    Array(tw.Range("F122"), "F37"), _
    Array(tw.Range("F123"), "F38"), _
    Array(tw.Range("F124"), "F39"), _
    Array(tw.Range("E129"), "XX") ' 替换为实际目标位置
)

' 新建工作簿
Set wkd = Workbooks.Add
With wkd
    Application.DisplayAlerts = False
    Sheets("Sheet1").Name = "1"
    .Sheets("1").HPageBreaks.Add Before:=.Sheets("1").Rows(42)
    .Sheets("1").VPageBreaks.Add Before:=.Sheets("1").Columns(13)
    Application.DisplayAlerts = True
    Set ms = .Sheets("1")
End With

' 循环处理所有数据源
For i = LBound(dataPairs) To UBound(dataPairs)
    If dataPairs(i)(0).Cells.Count > 1 Then
        ' 处理单元格区域，粘贴值和格式
        dataPairs(i)(0).Copy
        ms.Range(dataPairs(i)(1)).PasteSpecial xlPasteValuesAndNumberFormats
    Else
        ' 处理单个单元格，直接赋值
        ms.Range(dataPairs(i)(1)).Value = dataPairs(i)(0).Value
    End If
Next i

Application.CutCopyMode = False
End Sub

关键注意点 #

• 避免连续复制，剪贴板仅保留最后一次复制内容
• 单个单元格优先用直接赋值，比复制粘贴更高效稳定
• PasteSpecial需调用在Range对象上，参数可按需选择：
  • xlPasteValues：仅粘贴值
  • xlPasteValuesAndNumberFormats：粘贴值和数字格式
  • xlPasteAll：粘贴所有内容（包括公式、格式）

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