vba 复制范围并粘贴到新工作簿中

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/12340688/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 13:58:45  来源:igfitidea点击:

Copying range and pasting into new workbook

excel-vbavbaexcel

提问by CaptainProg

This should be really simple, but I've been trawling forums and SO answers for hours to find the answer with no luck, so am (reluctantly) creating a question of my own.

这应该非常简单,但是我已经在论坛和 SO 上搜索了几个小时的答案,但没有运气,所以我(不情愿地)创建了我自己的问题。

What I'm trying to do is simply create a new workbook, and paste a range from another workbook into that workbook. Sounds simple..?

我想要做的只是创建一个新工作簿,然后将另一个工作簿中的范围粘贴到该工作簿中。听起来很简单..?

My original workbook, let's call Book1. I'm trying to create a new workbook, Book2, which I will copy the valuesof cells A1:B10 to.

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

Here's one version of my code (starting with Book1 open):

这是我的代码的一个版本(从 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

This gives a "PasteSpecial of Range class failed" error. I have tried the following fixes with no luck:

这给出了“范围类的 PasteSpecial 失败”错误。我尝试了以下修复但没有成功:

  • added 'Workbooks("Book2.xls").Activate' to the code
  • removed the extra arguments in the PasteSpecial line
  • tried '.Paste' instead of '.PasteSpecial'
  • changed 'Selection.PasteSpecial' to 'ActiveSheet.PasteSpecial'
  • explicitly referencing the copy range, including the workbook and sheet reference
  • creating the new workbook first, then performing the copy, before reactivating the new workbook and pasting
  • 在代码中添加了“Workbooks("Book2.xls").Activate”
  • 删除了 PasteSpecial 行中的额外参数
  • 试过“.Paste”而不是“.PasteSpecial”
  • 将“Selection.PasteSpecial”更改为“ActiveSheet.PasteSpecial”
  • 显式引用复制范围,包括工作簿和工作表引用
  • 首先创建新工作簿,然后执行复制,然后重新激活新工作簿并粘贴

None of the above solutions work... any wisdom at this stage would be gratefully received!

以上解决方案都不起作用......现阶段的任何智慧都将不胜感激!

回答by Siddharth Rout

Is this what you are trying? I have commented the code so that you shouldn't have any problem understanding what the code does.

这是你正在尝试的吗?我已经对代码进行了注释,以便您理解代码的作用不会有任何问题。

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

回答by Beno?t Verbeeren

This works for me.

这对我有用。

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