正在复制区域并粘贴到新工作簿中



这应该很简单,但我已经在论坛和SO答案中搜索了几个小时,但没有找到答案,所以我(不情愿地)创建了一个自己的问题。

我想做的只是创建一个新的工作簿,并将另一个工作簿中的一个区域粘贴到该工作簿中。听起来很简单。。?

我的原始工作簿,我们称之为Book1。我正在尝试创建一个新的工作簿Book2,我将把单元格A1:B10的复制到它。

这是我的代码的一个版本(从打开的Book1开始):

Range("A1:B10").Copy
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs Filename:="Book2.xls"
    End With
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

这会出现"PasteSpecial of Range类失败"错误。我尝试了以下修复,但没有运气:

  • 在代码中添加了"工作簿("Book2.xls").Activate"
  • 删除了PasteSpecial行中的额外参数
  • 尝试了".Paste"而不是".PasteSpecial"
  • 已将"Selection.PasteSpecial"更改为"ActiveSheet.PasteSpecial"
  • 显式引用副本范围,包括工作簿和工作表引用
  • 先创建新工作簿,然后执行复制,然后重新激活新工作簿并粘贴

上述解决方案均无效。。。在这个阶段的任何智慧都会被感激!

这就是您正在尝试的吗?我已经对代码进行了注释,这样您就不会在理解代码的作用时遇到任何问题。

Option Explicit
Sub Sample()
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    '~~> Source/Input Workbook
    Set wbI = ThisWorkbook
    '~~> Set the relevant sheet from where you want to copy
    Set wsI = wbI.Sheets("Sheet1")
    '~~> Destination/Output Workbook
    Set wbO = Workbooks.Add
    With wbO
        '~~> Set the relevant sheet to where you want to paste
        Set wsO = wbO.Sheets("Sheet1")
        '~~>. Save the file
        .SaveAs Filename:="C:Book2.xls", FileFormat:=56
        '~~> Copy the range
        wsI.Range("A1:B10").Copy
        '~~> Paste it in say Cell A1. Change as applicable
        wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End With
End Sub

这对我有用。

Private Sub CommandButton1_Click()
Dim newWB As Workbook, currentWB As Workbook
Dim newS As Worksheet, currentS As Worksheet
'Copy the data you need
Set currentWB = ThisWorkbook
Set currentS = currentWB .Sheets("Sheet1")
currentS .Range("A:M").Select
Selection.Copy
'Create a new file that will receive the data
Set newWB = Workbooks.Add
    With newWB
        Set newS = newWB.Sheets("Sheet1")
        newS.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        'Save in CSV
        Application.DisplayAlerts = False
        .SaveAs Filename:="C:Temporary.csv", FileFormat:=xlCSV
        Application.DisplayAlerts = True
    End With
End Sub

最新更新