Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to copy the contents of the active sheet to a new workbook?

Tags:

excel

vba

I'm trying to copy the contents of the active sheet to a new workbook.

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

I'm getting an error at the PasteSpecial line with the error specified at the subject. I'm a bit confused since this works if I direct it to the source workbook.

Maybe I need to use Windows(output.xls)?

like image 934
yatici Avatar asked Jun 24 '13 17:06

yatici


3 Answers

Don't use Copy method at all if you're only concerned with saving the Values.

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

Note: this will fail (and so will your code, previously) if your ThisWorkbook is unsaved.

like image 176
David Zemens Avatar answered Nov 13 '22 14:11

David Zemens


I made it work:

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

I need to do it between activating windows or it doesn't work.

like image 20
yatici Avatar answered Nov 13 '22 15:11

yatici


If you are copying the entire area, then copy the worksheets:

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

If it copies a couple of columns that you don't need then you could delete this afterwards.

If you are copying from .xlsx to .xls then you'll need to use Copy/Paste:

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

If pasting values is required:

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

Be aware that UsedRange won't start from A1 unless this cell has some content. In which case, you'll have to define a Range object that starts at A1 and extends to the last used cell.

like image 1
Andy G Avatar answered Nov 13 '22 16:11

Andy G