I am very new to vba/macros, I created a macro that splits multiple sheets into new excel file. However, I get 1004 error when I run the macro.
Below is my code.
Private Sub CommandButton2_Click()
Dim workbookPath As String
workbookPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wSheet In ThisWorkbook.Sheets
wSheet.Copy
Application.ActiveWorkbook.SaveAs Filename:=workbookPath & "C\Path.xlsm" & wSheet.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Note macro button I have created in sheet1 named "Part1" and want to create new files from next sheet onwards. Please help....
You are trying to insert two paths into your line of code.
Since you defined the workbookPath variable you don't need to use "C\Path.xlsm". You need to remove "C\Path.xlsm" and insert "\" before wSheet.Name. see basic code below.
Comment out the Debug.Print(s) after you have used to verify.
Dim workbookPath As String: workbookPath = ThisWorkbook.Path 'ThisWorkbook is the macro enabled workbook.
Debug.Print ThisWorkbook.Path 'open the immediate window to varify to verify the path of the macro enabled workbook.
For Each wSheet In ThisWorkbook.Sheets
wSheet.Copy
ActiveWorkbook.SaveAs Filename:=workbookPath & "\" & wSheet.Name & ".xlsx"
'When you save a sheet as a workbook it becomes the activeworkbook
Debug.Print ActiveWorkbook.Path & "\"; ActiveWorkbook.Name 'use to verify the path of the new workbook.
ActiveWorkbook.Close False
Next wSheet
End Sub
Related
I'm running a code sample from https://trumpexcel.com/split-each-excel-sheet-into-separate-files/ to split an excel workbook into one file per worksheet.
I encountered the error `Run-time error '1004': We couldn't copy this sheet.'
'Code Created by Sumit Bansal from trumpexcel.com
Sub SplitEachWorksheet()
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
ws.Copy
Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
It turned out that the macro was tripping up when it encountered a hidden worksheet.
To fix this I updated the script to ignore hidden worksheets.
Final result
'Code Created by Sumit Bansal from trumpexcel.com
Sub SplitEachWorksheet()
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
If ws.Visible <> xlSheetHidden Then
ws.Copy
Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
Application.ActiveWorkbook.Close False
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I'm unable to comment on the original article so posting the fix here.
If you need to copy hidden sheets, you'll probably have to unhide it, copy the sheet, and then hide it again.
I want to copy multiple sheets from one workbook(4 out of 14) but i'm starting with one("Data"). I want to rename the workbook based on a cell in the first workbook. with this code I get an "run-time error '1004' Excel cannot access the file 'C:\3B4DD....
my code so far:
Sub Newyeartest()
sheetstocopy = "data"
Worksheets(sheetstocopy).Copy
Dim FName As String
Dim FPath As String
FPath = "C:"
FName = Sheets("data").Range("A1") & ".xlsm"
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName, FileFormat:=52
End sub
If I delete the "Fileformat:=52" It seems to go better but I get a text that this file must be saved as an macro enabled file. But I would guess that "Xlsm" is macro enabled?
Instead of copying worksheets, the better way is to copy the workbook with all the worksheets and then delete the ones that are not needed.
The code saves the workbook first, using the path of the current workbook;
Then it starts checking every worksheet, making sure that the name is not "data";
If the name is not "data" and there are more than 1 worksheets left, it deletes the worksheet;
The Application.DisplayAlerts = False is needed, in order to remove the msgbox for confirmation of the deletion of the worksheet. Then the Alerts are back set to True;
If the name is not "data" and this is the last worksheet, it gives a MsgBox "Last worksheet cannot be deleted!", as far as a workbook should always have at least 1 worksheet, by design;
Sub NewTest()
ThisWorkbook.SaveAs ThisWorkbook.Path & "\new.xlsm"
Dim sheetToCopy As String: sheetToCopy = "data"
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> sheetToCopy Then
If ThisWorkbook.Worksheets.Count > 1 Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(wks.Name).Delete
Application.DisplayAlerts = True
Else
MsgBox "Last worksheet cannot be deleted!"
End If
End If
Next wks
End Sub
This should do the trick:
Option Explicit
Sub Newyeartest()
Dim wb As Workbook
Dim SheetNames As Variant, Key As Variant
Dim FName As String, FPath As String
Application.ScreenUpdating = False
SheetNames = Array("data", "data2", "data3", "data4") 'store the sheet names you want to copy
Set wb = Workbooks.Add 'set a workbook variable which will create a new workbook
'loop through the sheets you previously stored to copy them
For Each Key In SheetNames
ThisWorkbook.Sheets(Key).Copy After:=wb.Sheets(wb.Sheets.Count)
Next Key
'delete the first sheet on the new created workbook
Application.DisplayAlerts = False
wb.Sheets(1).Delete
FPath = "C:\Test"
FName = ThisWorkbook.Sheets("data").Range("A1") & ".xlsm"
wb.SaveAs Filename:=FPath & "\" & FName, FileFormat:=52
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
You cannot save directly to C:\ so you need to create a folder and the code will work.
My first question to stackoverflow and new to VBA. I've looked everywhere and feel like I've tried everything to find a solution to the issue above.
I want to copy the same columns of each worksheet in a workbook to a new file based on the worksheet name.
I've found the following VBA code that copies the whole sheet, but am having the hardest time making it just copy Range("A:K") on each sheet to a new file.
I thought the following code might work but I am seriously way off.
Sub Splitbook()
'Updateby20140612
Dim xPath As String
Dim rng As Range
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
Set rng = Range("A:K")
xWs.rng.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Any help is greatly appreciated. And many thanks in advance.
Untested:
Sub Splitbook()
'Updateby20140612
Dim xPath As String, xWs as Worksheet
Dim rng As Range, wb as workbook
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
set wb = workbooks.add()
xWs.Range("A:K").Copy wb.sheets(1).range("A1")
wb.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
wb.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am generating a command button in access that will export data into Excel. At present, I have this function working and am trying to perfect it a little more such that each export will export the data onto a new sheet which will effectively be a copy of the ActiveSheet. The code that seems to be failing me is:
'Open workbook
Excel.Workbooks.Open "\\aos03s-fp04\brewsti2$\Alarms\ExportTest - " & Format(Now(), "dd-mm-yyyy") & ".xlsx", True, False
'Copy initial activesheet
ActiveSheet.Copy Before:=Excel.Sheets("Sheet2")
'Rename new copied sheet
ActiveSheet.Name = Me.RAW_TAG
The code fails on the ActiveSheet.Copy function. Any ideas?
Access has in build Command button procedure to Export Table to Excel. But, anyway, you can use this one:
Dim outputFileName As String
outputFileName = CurrentProject.Path & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Table1", outputFileName , True
Try this, alternatively:
Sub CopySheet()
Dim MySheetName As String
MySheetName = "TestSheet" Sheets("MasterSheet").Copy After:=Sheets("MasterSheet")
ActiveSheet.Name = MySheetName
End Sub
Try this, alternatively:
Sub CopySheet()
Dim MySheetName As String
MySheetName = "TestSheet" Sheets("MasterSheet").Copy After:=Sheets("MasterSheet")
ActiveSheet.Name = MySheetName
End Sub
Assuming this code is running in MS Access VBA, and Excel is an Excel Application object, you need to specify that ActiveSheet is a property of that Application object:
'Open workbook
Excel.Workbooks.Open "\\aos03s-fp04\brewsti2$\Alarms\ExportTest - " & Format(Now(), "dd-mm-yyyy") & ".xlsx", True, False
'Copy initial activesheet
Excel.ActiveSheet.Copy Before:=Excel.Sheets("Sheet2")
'Rename new copied sheet
Excel.ActiveSheet.Name = Me.RAW_TAG
I'm trying to do the following:
Export/Copy particular sheets in the workbook (any sheet name that contains "Upload") to a particular file directory.
I don't want these worksheet names to change nor the workbook name to change.
The file-name is consistent for each worksheet, so it would be okay to replace the files in the directory whenever I run the macro. It is okay to have a dialog box that asks if I'm sure I want to replace each of the files.
I don't want the newly created CSVs or any other file to open.
Sub SheetsToCSV()
'Jerry Beaucaire (1/25/2010), updated (8/15/2015)
'Save each sheet to an individual CSV file
Dim ws As Worksheet, fPATH As String
Application.ScreenUpdating = False 'speed up macro
Application.DisplayAlerts = False 'automatically overwrite old files
fPATH = "C:\2015\CSV\" 'path to save into, remember the final \ in this string
For Each ws In Worksheets
ws.Copy
ActiveWorkbook.SaveAs Filename:=fPATH & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Next ws
Application.ScreenUpdating = True
End Sub
You just need to add a simple loop through all worksheets and test the name.
Try this:-
Sub COPYSelectedSheetsToCSV()
Dim ws As Worksheet
'In case something goes wrong
On Error GoTo COPYSelectedSheetsToCSVZ
'Loop through all worksheets
For Each ws In ActiveWorkbook.Sheets
'Does the name contain "Upload"
If InStr(1, ws.Name, "Upload") > 0 Then
'Make the worksheet active
ws.Select
'Save it to CSV
ActiveWorkbook.SaveAs Filename:="/Users/reginaho/Desktop/Upload/" & ws.Name & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
End If
Next
COPYSelectedSheetsToCSVX:
'Clean up the memory usage
Set ws = Nothing
Exit Sub
COPYSelectedSheetsToCSVZ:
MsgBox Err.Number & " - " & Err.Description
Resume COPYSelectedSheetsToCSVX
End Sub