宏将范围复制到新工作簿

时间:2013-02-01 12:15:40

标签: excel vba

如何创建可执行以下操作的宏:

  1. 将范围A2:AT10000从一个工作簿复制到新工作簿的第一张工作表。
  2. 返回初始工作簿并在工作表中选择范围A6:HF10000:Sheet11
  3. 将所选内容粘贴到步骤1中创建的工作簿的新添加工作表(表2)
  4. 我得到运行时错误424,在调试时,突出显示的行是 Sheet11.Range("A6:HF10000").Select

    Sub Copy2RangesNewWorkbook()
    '
    ' Copy2RangesNewWorkbook Macro
    '
    Dim pvt_wbk_New As Excel.Workbook
    Dim pvt_xls_Current As Excel.Worksheet
    
    With pvt_xls_Current
    ActiveSheet.Range("A2:AT10000").Select
    Selection.Copy
    End With
    
    Set pvt_wbk_New = Application.Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    With pvt_xls_Current
    Sheet11.Range("A6:HF10000").Select
    Selection.Copy
    End With
    
    With pvt_wbk_New
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    End Sub
    

1 个答案:

答案 0 :(得分:1)

尝试:

Sub Copy2RangesNewWorkbook()

Dim pvt_wb_New As Excel.Workbook
Dim pvt_ws_NewTarget1 As Worksheet
Dim pvt_ws_NewTarget2 As Worksheet
Dim pvt_ws_Current As Worksheet
Dim pvt_wb_Current As Workbook

Set pvt_ws_Current = ActiveSheet
Set pvt_wb_Current = ActiveWorkbook
Set pvt_wb_New = Application.Workbooks.Add
Set pvt_ws_NewTarget1 = pvt_wb_New.Sheets(1)
Set pvt_ws_NewTarget2 = pvt_wb_New.Worksheets.Add

pvt_ws_Current.Range("A2:AT10000").Copy
pvt_ws_NewTarget1.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

pvt_wb_Current.Sheets("Sheet11").Range("A6:HF10000").Copy
pvt_ws_NewTarget2.Range("A6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub