The following is my code in an attempt to delete a number of sheets in order to save a workbook with specific worksheets only:
Sub SeperateWB2()
Dim ws As Worksheet
Dim wb As Workbook
Dim sheetname As Variant
Dim ddl As Variant
ddl = "PhaseTransferDropDowns"
sheetname = InputBox("Please specify sheet name:")
Path = "C:\My Documents\Phase Transfer\Test\"
For Each ws In ThisWorkbook.Worksheets 'SetVersions
If Not ws.Name = sheetname And Not ws.Name = ddl Then
Application.DisplayAlerts = False
ws.Delete
End If
Next ws
wb.SaveAs Path & ws.Name & ".xlsx", Excel.XlFileFormat.xlOpenXMLWorkbook
wb.Close
Set wb = Nothing
End Sub
The loop works fine but it refuses to save the workbook on the path I have specified.
I get this message: "Runtime error 91: Object variable or With block variable not set"
Can anyone help?
Look at your error message: Object variable or With block variable not set
It looks like you aren't able to save because you never instantiate your wb variable. Therefore wb = Nothing. You can't perform SaveAs on nothing. Try adding Set wb = ThisWorkbook below your declarations like so:
'other code
Dim ws As Worksheet
Dim wb As Workbook
Dim sheetname As Variant
Dim ddl As Variant
Set wb = ThisWorkbook
ddl = "PhaseTransferDropDowns"
'other code
The wb object variable is never assigned to anything other than Nothing. But anyway you can use ThisWorkook, if you mean to save and close the workbook that contains the running code:
With ThisWorkbook
.SaveAs Path & ws.Name & ".xlsx", Excel.XlFileFormat.xlOpenXMLWorkbook
.Close
End With
Thanks everyone!
It seems that I needed to set the workbook properly (Set wb = ThisWorkbook).
I also needed to change ws.name into sheetname.
This is the code that worked at the end:
Sub SeperateWB2()
Dim ws As Worksheet
Dim wb As Workbook
Dim sheetname As Variant
Dim ddl As Variant
Set wb = ThisWorkbook
ddl = "PhaseTransferDropDowns"
sheetname = InputBox("Please specify sheet name:")
Path = "C:\My Documents\Phase Transfer\Test\"
For Each ws In ThisWorkbook.Worksheets 'SetVersions
If Not ws.Name = sheetname And Not ws.Name = ddl Then
Application.DisplayAlerts = False
ws.Delete
End If
Next ws
wb.SaveAs Path & sheetname & ".xlsx", Excel.XlFileFormat.xlOpenXMLWorkbook
'wb.Close
End Sub
Related
I have a script that will print everything in my "Downloads" folder, the VBA script did work until I added a bit of code to "Fit Columns to Width" so that I could see all data before it printed, now it says "Subscript out of range" once it opens the first file in the "Downloads" folder, I think this is because the "Sheet1" is never called "Sheet1" it is instead named the first 15 characters of the actual file name.
Is anybody able to offer any assistance?
The Bit I've just added:
Worksheets("Sheet1").Columns("A:H").AutoFit
My Full Code:
Dim wb As Workbook, ws As Worksheet
Dim FileName As String, Path As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Path = "C:\Users\Jonathan.mackell\Downloads\*.csv"
FileName = Dir(Path, vbNormal)
Do Until FileName = ""
Application.DisplayAlerts = False
Workbooks.Open Left(Path, Len(Path) - 5) & FileName
Worksheets("Sheet1").Columns("A:H").AutoFit
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
ws.PrintOut
Next
wb.Close
FileName = Dir()
Loop
End Sub
Any help appreciated!
set the wb variable when you open it instead of using activeworkbook, and include the sh variable instead of using activesheet, and put that in your loop, so you dont need to know the name.
Sub Test
Dim wb As Workbook, ws As Worksheet
Dim FileName As String, Path As String
Path = "C:\Users\Jonathan.mackell\Downloads\*.csv"
FileName = Dir(Path, vbNormal)
Do Until FileName = ""
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Left(Path, Len(Path) - 5) & FileName)
For Each ws In wb.Worksheets
ws.Columns("A:H").AutoFit
ws.PrintOut
Next
wb.Close
FileName = Dir()
Loop
End Sub
I'm attempting to write a program to loop through a directory of excel files and copy a range into a "Master Workbook". When I run the program I am prompted with "Code execution has been interrupted". If I select continue the code will successfully run but then a "run-time error '-2147221080' Automation error" appears.
The line that causes the error is:
Set ws = wb.Worksheets("Project Log")
My question is, why is this line causing the error and or is there a way to bypass the error prompt so that my code will successfully run?
Sub FileCompiler()
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim Masterwb As Workbook
Dim ws as Worksheet
'set workbook in which data will be copied to
Set Masterwb = ActiveWorkbook
'declare path
'folderPath = "C:MyPath\"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
'compile directory data to master spreadsheet
Filename = Dir(folderPath & "*.xls*")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
Set ws = wb.Worksheets("Project Log")
ws.Range(ws.Cells(2, "C"), ws.Cells(2, "C")).Copy
Masterwb.Worksheets("Staging").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
ws.Range(ws.Cells(7, "A"), ws.Cells(Rows.Count, "K").End(xlUp)).Copy
Masterwb.Worksheets("Staging").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
wb.Close True
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub
Dim Finfo As String
Dim FilterIndex As Long
Dim Title As String
Dim CopyBook As Workbook
Dim CopySheet As Worksheet
Dim ForecastFileName As Variant
Dim MasterSheet AS Worksheet
Set MasterSheet = ThisWorkbook.Worksheets("Yoursheetname")
'now you can always use master sheet after you set copybook
'Set up file filter
Finfo = "Excel Files (*.xls*),*.xls*"
'Set filter index to Excel Files by default in case more are added
FilterIndex = 1
' set Caption for dialogue box
Title = "Hey there!, select a file"
'get the Forecast Filename
ForecastFileName = Application.GetOpenFilename(Finfo, FilterIndex, Title)
'Change this according to what you need for workbook and worksheet names
Workbooks.Open (ForecastFileName)
Set CopyBook = ActiveWorkbook
Set CopySheet = CopyBook.Worksheets(1)
'Do your code, remember to close
CopyBook.Close savechanges:=False 'Not needed now
You might want to check for the ForecastFileName being False, that is when the users x's out, you will also want to do a little validation the wb sheet is in the right format by checking column headers ect or you will wind up crashing.
I have invoice with lots of Data. I want to Export and import data. I have created Export VBA that exports particular sheet ("Invoice Data"). I have saved it somewhere. Now I need to import that same file into active worksheet.
I have this code
Dim WB As Workbook
Dim SourceWB As Workbook
Dim WS As Worksheet
Dim ASheet As Worksheet
'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.EnableEvents = False
'Sets the variables:
Set WB = ActiveWorkbook
Set ASheet = ActiveSheet
Set SourceWB = Workbooks.Open(WB.Path & "\1.xlsx") 'Modify to match
'Copies each sheet of the SourceWB to the end of original wb:
For Each WS In SourceWB.Worksheets
WS.Copy after:=WB.Sheets(WB.Sheets.Count)
Next WS
SourceWB.Close savechanges:=False
Set WS = Nothing
Set SourceWB = Nothing
WB.Activate
ASheet.Select
Set ASheet = Nothing
Set WB = Nothing
Application.EnableEvents = True
this code works pretty well. but i want to choose the file with file open dialog
Anyone help me please
Finally found the code....
Dim wbk1 As Workbook, wbk2 As Workbook
fileStr = Application.GetOpenFilename()
Set wbk1 = ActiveWorkbook
Set wbk2 = Workbooks.Add(fileStr)
wbk2.Sheets("invoice data").Copy After:=wbk1.Sheets(1)
thank you guys
if your question is about.. how to use File open dialog.. you can use this code
NewWorkbook = Application.GetOpenFilename( _
FileFilter:="Excel 2003 (*.xls),*.xls,Excel 2007 (*.xlsx),*.xlsx,Excel 2007 (*.xlsm),*.xlsm", _
Title:="Select an Excel File", _
MultiSelect:=File)
If NewWorkbook = False Then
Exit Sub
Else
Workbooks.Open Filename:=NewWorkbook
End If
You can remove filters if you want to select any kind of files
I cant seem to get the code to loop to the next workbook open. After that I would like to consolidate all the single worksheets in each workbook into a single workbook and rename each tab based on it's workbook name.
I am not too far but sentence one is my first task
Sub cullworkbooksandCONSOLIDATE()
Dim ws As Worksheet
Dim wb As Workbook
Dim wsNAME As String
For Each wb In Application.Workbooks
With wb
For Each ws In ActiveWorkbook.Worksheets
With ws
wsNAME = ws.Name
If wsNAME <> "summary details" Then
ws.Delete
End If
End With
Next
End With
Next
End Sub
thank you kindly
Or more directly, just copy the sheet if it exists, rather than deleting all the non matches (which will also cause an error if the code deletes all sheets)
Sub cullworkbooksandCONSOLIDATE()
Dim wb As Workbook
Dim wb1 As Workbook
Dim ws As Worksheet
Dim wsNAME As String
Set wb1 = Workbooks.Add(1)
wsNAME = "summary details"
For Each wb In Application.Workbooks
With wb
If .Name <> wb1.Name Then 'if it's not the export workbook
On Error Resume Next
Set ws = wb.Sheets(wsNAME)
On Error GoTo 0
If Not ws Is Nothing Then ws.Copy Before:=wb1.Sheets(1)
End If
End With
Next
End Sub
This is so not going into my resumé.
Sub cullworkbooksandCONSOLIDATE()
Dim ws As Worksheet
Dim wb As Workbook
Dim wsNAME As String
Dim wbex As Workbook
'You'll need to define wbex, this is where your worksheets will be inserted
For Each wb In Application.Workbooks
With wb
If .Name <> wbex.Name Then 'if it's not the export workbook
For Each ws In wb.Worksheets 'not necessarily active workbook
With ws
wsNAME = LCase(.Name)
If wsNAME <> "summary details" Then
.Delete 'why do you need to delete it?
Else
.Name = wb.Name
.Copy Before:=wbex.Sheets(1)
End If
End With
Next
.Close SaveChanges:=False 'you really don't want to corrupt your source data, do you?
End If
End With
Next
End Sub
I would like to save a number of worksheets from the current workbook to a different workbook and exclude a sheet named "buttons" (in current one) from that saving process.
Can anybody help please? The number of worksheets is changeable FYI.
Below is what I have so far which include all the sheets from current workbook.
Sub SaveAs()
D1 = VBA.Format(Now, "mm_DD_yyyy")
For Each ws In Application.Workbooks
ws.SaveAs Filename:="C:\Users\e2309\Desktop\Andy's\GBB_Report_" & D1 & ".csv"
Next ws
Application.Quit
End Sub
Or more directly
copy the entire workbook
delete the redundant sheet
code
Sub Simpler()
Dim wb As Workbook
Dim strFile As String
strFile = "C:\temp\yourfile.xlsm"
ThisWorkbook.SaveAs strFile, xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
ThisWorkbook.Sheets("buttons").Delete
Application.DisplayAlerts = True
End Sub
This might get you a little closer. Note this is not complete and very untested.
Sub work()
Dim WB As Workbook
Dim Nwb As Workbook
Dim WS As Worksheet
Set Nwb = New Workbook
Set WB = ThisWorkbook
For Each WS In WB.Sheets
If WS.Name <> "Don't copy" Then
WS.Copy Nwb.Sheets("sheet1")
End If
Next
Nwb.Save
End Sub