Question

我在这个网站上看了几个类似的问题，但似乎没有人能做到这一点。我正在尝试创建一个新工作簿，复制其活动工作表的内容并将其粘贴到这个新创建的工作簿中。以下是我正在使用的代码：

Sub new_workbook()


Dim ExtBk As Workbook
Dim ExtFile As String


Columns("A:N").Copy

Workbooks.Add.SaveAs Filename:="output.xls"
ExtFile = ThisWorkbook.Path & "\output.xls"


Set ExtBk = Workbooks(Dir(ExtFile))
ExtBk.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone


Application.DisplayAlerts = False
ExtBk.Save
Application.DisplayAlerts = True

End Sub

我在PasteSpecial行收到错误，并在主题中指定了错误。我有点困惑，因为如果我将它指向源工作簿，这是有效的。

也许我需要使用Windows（output.xls）？

Answer 1

如果您只关心保存值，请不要使用Copy方法。

Sub new_workbook()
Dim wbMe As Workbook: Set wbMe = ThisWorkbook
Dim ws As Worksheet: Set ws = wbMe.ActiveSheet
Dim ExtBk As Workbook

Set ExtBk = Workbooks.Add
ExtBk.SaveAs Filename:=wbMe.Path & "\output.xls"

ExtBk.Worksheets("Sheet1").Range("A:N").Value = ws.Range("A:N").Value

Application.DisplayAlerts = False
ExtBk.Save
Application.DisplayAlerts = True

End Sub

注意：如果您的ThisWorkbook未保存，则会失败（以前的代码也会失败）。

Answer 2

所以如果有人有兴趣阅读它，我就会成功：

Sub cp2NewWb()
Dim ExtFile As String
ExtFile = ThisWorkbook.Path & "output.xls"
Workbooks.Add.SaveAs Filename:="output.xls"

Windows("test1.xlsm").Activate
Range("A1:AA100").Copy
Windows("output.xls").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Worksheets(Worksheets.Count).Columns("A:AA").EntireColumn.AutoFit
Range("A1").Select

Windows("test1.xlsm").Activate
Application.CutCopyMode = False
Range("A1").Select

End Sub 所以我想在激活窗口之间进行操作或者它不起作用。

Answer 3

如果要复制整个区域，请复制工作表：

Worksheets("Sheet1").Copy Workbooks(2).Worksheets(1)

如果它复制了一些您不需要的列，那么您可以在之后删除它。

如果您要从.xlsx复制到.xls，那么您需要使用复制/粘贴：

Worksheets("Sheet1").UsedRange.Copy Workbooks(2).Worksheets(1).Range("A1")

如果需要粘贴值：

Workbooks(2).Worksheets(1).UsedRange.Copy
Workbooks(2).Worksheets(1).Range("A1").PasteSpecial xlPasteValues

请注意UsedRange不会从A1开始，除非此单元格包含某些内容。在这种情况下，您必须定义一个从A1开始的Range对象，并扩展到最后一个使用过的单元格。

Answer 4

Private Sub ExceltoExcel()
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    'Input Data
     Sheets("Sheet1").Cells(1, 1).Select
     col = Sheets("Sheet1").Cells(2, 2)
     Dim exlApp As Excel.Application
     Dim ExtBk As Excel.Workbook
     Dim exlWs As Excel.Worksheet
     ExtFile = ThisWorkbook.Path & "\output.xls"
     Set exlApp = CreateObject("Excel.Application")
     Set ExtBk = exlApp.Workbooks.Open(ExtFile)
     Set exlWs = exlWb.Sheets("Sheet1")
     ExtBk.Activate
     exlWs.Cells(2, 2) = col
     'Output Data
     exlWs.Range("A1").Select
     exlWb.Close savechanges:=True
     Set ecxlWs = Nothing
     Set exlWb = Nothing
     exlApp.Quit
     Set exlApp = Nothing
     Application.EnableEvents = True
     Application.DisplayAlerts = True
End Sub

错误：范围类的Pastespecial方法失败

4 个答案: