I am hoping someone can assist. I have an excel macro filing (.xlsm) where I am pulling in data from other files and I am creating multiple Worksheets. I am trying to export one of those worksheets to a new Workbook that I'm creating each day with a dynamic file name, the file name includes the current date. I'm getting an error that "Excel cannot insert the sheets into the destination workbook, because it contains few rows and columns than the source workbook...". I assume this is because I am attempting to copy from .xlsm to .xlxs and I'm not sure how to solve this. Here is the code that I have:
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Data").Copy Before:=wb.Sheets(1)
wb.SaveAs "\\NetorkDrive\Filename " & Format(Now(), "MM_DD_YY") & ".xlsx"
I was expecting the information from the "Data" sheet to copy over to a new Workbook titled "Filename Date.xlsx" but I am getting the error referenced above.
Export Worksheet To a New Workbook
Sub ExportWorksheet()
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = swb.Sheets("Data")
sws.Copy ' creates a single-worksheet workbook
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count) ' the last
Dim dPath As String
dPath = "\\NetworkDrive\Filename " & Format(Date, "MM_DD_YY") & ".xlsx"
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs dPath, xlOpenXMLWorkbook
Application.DisplayAlerts = True
'dwb.Close SaveChanges:=False ' it just got saved
MsgBox "Worksheet exported.", vbInformation
End Sub
Related
Is there a way to save the active/selected worksheet without having to specify sheets(1)?
The code below is execute via command button and will take the worksheet "Quote" copy to a new workbook, and then prompt to save under the downloads directory.
I'm also trying to get that button to save whichever sheet is selected, it could be Quote or Sheet1, but not both.
Private Sub CommandButton4_Click() ' save worksheet
'Gets the name of the currently visible worksheet
Filename = ActiveSheet.Name
'Puts the worksheet into its own workbook
ThisWorkbook.ActiveSheet.Copy
'Saves the workbook - uses the name of the worksheet as the name of the new workbook
'Filename = Range("A1")
'ActiveWorkbook.Save
Dim NameFile As Variant
With Worksheets("Quote")
'NameFile = .Range("A1") & "_" & .Range("B5") & "_" & ".xls"
End With
NameFile = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Downloads\" & NameFile, Filefilter:="Fichier Excel (*.xls), *.xls")
If NameFile = False Then
MsgBox "File not saved"
Else
ActiveWorkbook.SaveAs Filename:=NameFile
End If
'Closes the newly created workbook so you are still looking at the original workbook
ActiveWorkbook.Close
End Sub
This Sub creates a new Workbook from a sheet. But you must have a way to call this Sub of every sheet, or a better place is a button in the ribbon witch in it's handler: Call NewBookOfSheet(ActiveSheet).
Public Sub NewBookOfSheet(ws As Worksheet)
Dim nwb As Workbook, curwb As Workbook
If ws Is Nothing Then Exit Sub
Set curwb = ws.Parent
Set nwb = Workbooks.Add
curwb.Activate
ws.Select
ws.Copy Before:=nwb.Sheets(1)
nwb.Activate
Application.Dialogs(xlDialogSaveAs).Show ws.Name
End Sub
Copy the Active Worksheet to a New Workbook
Private Sub CommandButton4_Click() ' save worksheet
If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
Dim sws As Worksheet: Set sws = ActiveSheet
sws.Copy
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
Dim dws As Worksheet: Set dws = dwb.Sheets(1) ' the one and only
Dim dwbName: dwbName = Application.GetSaveAsFilename( _
InitialFileName:=Environ("USERPROFILE") & "\Downloads\" & dws.Name, _
FileFilter:="Fichier Excel (*.xls), *.xls")
If dwbName = False Then
MsgBox "File not saved", vbCritical
Else
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=dwbName, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
End If
dwb.Close SaveChanges:=False
' Now 'dws' and 'dwb' are invalid but still 'Not Nothing'.
' On the other hand, 'sws' still points to the (initial) source worksheet.
' If you need to reference the source workbook use:
'Dim swb As Workbook: Set swb = sws.Parent
End Sub
I have several sheets I need to copy to a new workbook and then save this workbook.
I'm using the worksheet function to copy which it seems to me like it's the intended purpose of that function.
Here's the MSDN documentation on how to do this task:
Worksheets("Sheet1").Copy
With ActiveWorkbook
.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False
End With
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy
This is doing exactly what I want, but it's using the ActiveWorkbook property which might cause some error, if running other codes or just working in parallel of this code running.
I'm looking for a way to manipulate the newly created workbook without having to use the ActiveWorkbook property.
Something along the lines of this:
Dim wb as Workbook
set wb = Worksheets("Sheet1").Copy
wb.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
wb.Close SaveChanges:=False
I've already tried this and it didn't work, but it's just to illustrate the point that it's not using the ActiveWorkbook property to refer to the new workbook.
Thanks in advance
From above comment:
Sub Tester()
With AsNewWorkbook(Sheet1)
Debug.Print .Name
.SaveAs "C:\Temp\blah.xlsx"
End With
End Sub
Function AsNewWorkbook(ws As Worksheet)
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet) 'has one sheet...
With wb.Sheets(1) 'stolen from Cristian's answer...
If .Name = ws.Name Then .Name = .Name & "x"
End With
ws.Copy before:=wb.Worksheets(1)
Application.DisplayAlerts = False
wb.Worksheets(2).Delete
Application.DisplayAlerts = True
Set AsNewWorkbook = wb
End Function
#BigBen is right though - typically just using ActiveWorkbook is fine.
An improvement on #TimWilliams response so that you can copy multiple sheets at once:
Sub Test()
Dim sourceBook As Workbook
'
Set sourceBook = ThisWorkbook 'Or ActiveWorkbook or whatever book is needed
With CopySheetsToNewBook(sourceBook.Sheets(Array("Sheet1", "Sheet2")))
.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
End With
sourceBook.Close SaveChanges:=False
End Sub
Public Function CopySheetsToNewBook(ByVal theSheets As Sheets) As Workbook
If theSheets Is Nothing Then
Err.Raise 91, "CopySheetsToNewBook", "Sheets not set"
End If
'
Dim newBook As Workbook
Dim tempSheet As Worksheet
'
Set newBook = Application.Workbooks.Add(xlWBATWorksheet)
Set tempSheet = newBook.Worksheets(1) 'To be deleted later
tempSheet.Name = CDbl(Now) 'Avoid name clashes with the sheets to be copied
'
theSheets.Copy Before:=tempSheet
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
'
Set CopySheetsToNewBook = newBook
End Function
Copy Worksheet(s) to a New Workbook
Sub NewWorkbook()
' Reference the source workbook.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
swb.Worksheets("Sheet1").Copy ' copy one worksheet to a new workbook
'swb.Worksheets(Array("Sheet1", "Sheet2")).Copy ' copy multiple worksheets
' Reference the destination (new) workbook.
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
Debug.Print swb.Name, dwb.Name
End Sub
I am currently using following code to save an Excel workbook. Instead of saving complete work book, I just wish to save a sheet in this workbook named Reconciliation. All values in the sheet should be saved as values while keeping the formatting the same.
Sub Button3_Click()
' Yes
' Code to save consumer wise mirs on the desktop
Dim Path As String
Dim filename As String
On Error GoTo Err_Clear
Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Err_Clear:
If Err <> 0 Then
MkDir CreateObject("wscript.shell").specialfolders("desktop") & "\rohailnisar"
Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
End Sub
Export a Worksheet
This saves a copy of a worksheet as the only sheet in a new workbook in the same folder. Before saving, it converts formulas to values. It is saved in the .xlsx format 'removing' any code.
If the code is in the open (initial) workbook, then replace ActiveWorkbook with ThisWorkbook.
Option Explicit
Sub SaveWorksheet()
On Error GoTo ClearError
Dim swb As Workbook: Set swb = ActiveWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets("Reconciliation")
Dim FolderPath As String: FolderPath = swb.Path & Application.PathSeparator
Dim BaseName As String: BaseName = sws.Range("E1").Value
Dim FilePath As String: FilePath = FolderPath & BaseName & ".xlsx"
sws.Copy
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
dwb.Worksheets(1).UsedRange.Value = dwb.Worksheets(1).UsedRange.Value
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
'dwb.Close
ProcExit:
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume ProcExit
End Sub
Instead of saving complete work book, I just wish to save a sheet in this workbook named Reconciliation. All values in the sheet should be saved as values while keeping the formatting the same.
Code
Dim wbThis As Workbook
Dim wsThis As Worksheet
Dim wbThat As Workbook
Dim wsThat As Worksheet
'~~> Change this to the workbook which has the Reconciliation sheet
Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets("Reconciliation")
'~~> This will create a new workbook with only Reconciliation
wsThis.Copy
'~~> Get that object. It will be last in the queue
Set wbThat = Workbooks(Workbooks.Count)
Set wsThat = wbThat.Sheets("Reconciliation")
'~~> Convert to values
wsThat.UsedRange.Value = wsThat.UsedRange.Value
'~~> Save that workbook
wbThat.SaveAs Filename:=Path & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
I've been looking on StackOverflow for a solution to this problem and I'm almost there but I can't seem to solve my last problem: saving only a specific worksheet to a new file. Basically, what I want to do is the following:
User clicks and "Archive Data" button
User is prompted to choose a filepath and "SaveAs" a new Excel workbook
Code will copy the range of data in the current worksheet
Code will paste that range to the new Excel workbook specified in the "SaveAs"
My problem is that it saves the whole workbook and I have no way of copying and pasting/saving the specific range in the desired worksheet. Please see the code for reference and let me know if you have any questions.
Sub ArchiveData()
Dim ThisFile As String
Dim NewFile As String
Dim ActBook As Workbook
Dim NewShtName As String
Dim NewFileType As String
NewShtName = "Archived Data on " & Format(Date, "MM.DD.YYYY")
'Copy
ThisFile = ThisWorkbook.FullName
NewFileType = "Excel 1997-2003 (*.xls), *.xls,Excel 2007-2013 (*.xlsx), .*xlsx,Excel 2007-2013 Macro-Enabled (*.xlsm), .*xlsm)"
NewFile = Application.GetSaveAsFilename(InitialFileName:=NewFileName, FileFilter:=NewFileType)
'Paste
If NewFile = "False" Then
MsgBox ("File unable to be saved")
Exit Sub
Else
ActiveWorkbook.Sheets(2).SaveAs Filename:=NewFile, FileFormat:=51 'Need to save as .xls and/or .xlsx
ThisWorkbook.Sheets(2).range("A4:S65536").Copy
ActiveWorkbook.Sheets(1).range("A4:S65536").PasteSpecial (xlPasteValues)
ActiveWorkbook.Sheets(1).Name = NewShtName
'Close new book
Set ActBook = ActiveWorkbook
Workbooks.Open ThisFile
ActBook.Close
End If
MsgBox ("File saved")
End Sub
You would use something like this to copy the sheet to a new workbook, which becomes active, then save it using the path specified by the user:
ActiveWorkbook.Sheets(2).Copy
Activeworkbook.SaveAs Filename:=NewFile, FileFormat:=51
If you don't want the whole sheet, you can use:
Dim wb as Workbook
Set wb = Workbooks.Add(xlwbatworksheet)
ThisWorkbook.Sheets(2).range("A4:S65536").Copy
wb.Sheets(1).range("A4").PasteSpecial xlPasteValues
wb.saveas Filename:=NewFile, FileFormat:=51
I am trying to copy an object from a closed workbook to the currently open workbook, the code I have bee experimenting with is:
Sub test()
Dim WB1 As Workbook
Dim WBDest As Workbook
Set WBDest = Workbooks(ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("path to the folder\testbook.xlsx")
WB1.Sheets("Sheet1").Range("A1:F12").Copy
'paste in second workbook
WBDest.Sheets("Sheet1").Range("A1").PasteSpecial
'Close first workbook
WB1.Close savechanges:=False
End Sub
I keep getting a "subscript out of range" error with this, if I remove the WBDest info and used activeworkbook instead, it copies the object and pastes it in the same workbook as it is the activeworkbook at the time.
Could someone please guide me on this and help me figure out what I am doing wrong.
Thanks.
As mentioned by AndyG, it should be WBDest = Workbooks.Open(..). The replacement is then:
Sub test()
Dim WB1 As Workbook
Dim WBDest As Workbook
Set WBDest = Workbooks.Open(ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("path to the folder\testbook.xlsx")
WB1.Sheets("Sheet1").Range("A1:A7").Copy
'paste in second workbook
WBDest.Sheets("Sheet1").Range("A1:A7").PasteSpecial
'Close first workbook
WB1.Close savechanges:=False
End Sub
Note that on the 5th line you could as easily write WBDest = ActiveWorkbook if the workbook is already open as you suggest.