The below short VBA code exports multiple PDFs from a workbook, it cycles through the worksheets to see if anything is contained in cell A1 then exports as PDF only if the cell is populated.
Sub PrintPDFs()
Const theValueToStop As String = ""
Const theAddress As String = "A1"
Dim ws As Worksheet
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
If ws.Range(theAddress).Value <> theValueToStop Then
ws.ExportAsFixedFormat xlTypePDF, IgnorePrintAreas:=False, Filename:= _
ActiveWorkbook.Path & "\" & date & "marketstudy " & ws.Name & ".pdf"
End If
Next ws
End Sub
This has worked perfectly for myself, however some of my colleagues are having difficulty with printing as it sometimes is formatted differently. I want it to always fit every worksheet onto a single PDF.
Appreciate any help given.
Related
Very novice VBA coder, I have manged through a lot of trail and error create a code to
save multiple sheets as seperate pdf:s excluding some sheets.
Now I want to copy that code and adjust it so I can also have a macro that saves all sheets to one singel PDF and excluding some sheets the same way.
This is my current code,
Sub LoopSheetsSaveAsPDF()
'Create variables
Dim ws As Worksheet
'Loop through all worksheets and save as individual PDF in same folder
'as the Excel file
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Mall", "Grunddata"
''/// ignore these sheets
Case Else
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "/" & ws.Name & ".pdf"
End Select
Next ws
End Sub
I cant find the part i the code that specify it should be saved as multiple pdf:s or only one.
Would be very thankful for all help.
BR
Fredrik
Like this:
Sub LoopSheetsSaveAsPDF()
Dim ws As Worksheet, repl As Boolean, n As Long
repl = True 'first sheet selection replaces any previous selection
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Mall", "Grunddata"
''/// ignore these sheets
Case Else
ws.Select Replace:=repl
repl = False 'subsequent sheets get added
End Select
Next ws
If Not repl Then 'got at least one sheet?
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "/AllSheets.pdf"
End If
End Sub
Currently learning VBA in bits and pieces.
Confused on where to insert a condition in the following piece to check each worksheet respectively on cell address E8 for example for ANY entry other than “”.
Sub SaveWorkshetAsPDF()
Dim ws As Worksheet
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
ws.Select
ws.ExportAsFixedFormat xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & timestamp & ws.Name & ".pdf"
Next ws
End Sub
Any assistance would be amazing.
Want it to stop exporting if a value is present in a specified cell.
I think this should get you what you need. I included some comments that might help out a little and give you a method to have a condition to check.
A couple notes to improve:
Always good to define variable such as timestamp.
No need to actively select the sheet, you can get the file's workbook path using the parent property.
For items that are hard-coded, I'm a fan of putting the values at the top of the macro as constants. It makes changing things easier.
Hope this helps.
Sub SaveWorkshetAsPDF()
Const theValueToStop As String = "Stop" 'or whatever, if it's a number change to Long
Const theAdddress As String = "E8" 'makes it easier to find and change if needed.
Dim ws As Worksheet, timestamp As String
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
'no neeed to select use parent property for address.
'ws.Select
If ws.Range(theAdddress).Value <> theValueToStop Then
ws.ExportAsFixedFormat xlTypePDF, Filename:= _
ws.Parent.Path & "\" & timestamp & ws.Name & ".pdf"
End If
Next ws
End Sub
I really appreciate if someone here would help me crack this problem which i cant find the solution (and sorry for my bad english).
So i have multiple excels in one folder. every excel in it have same format 1st sheet for reference of every sheet, 2nd sheet for consolidation data, and 3rd sheet and the rest for the data to be consolidated. Every excel in the folder have various amount of sheet.
What i want to do is i want to copy data from range A27:AJ500 that begin from 3rd sheet to every sheet after, into another new workbook in sheet1 and paste it begin from cell A27 over and over into the bottom and looping for every excel in folder.
i dont have enough ability yet to write my own script but i managed to understand some and combine it into this script.
Sub Download_Data()
Path = "C:\Users\ASUS\Desktop\Done\"
Filename = Dir(Path & "*.xlsm")
'to open every excel in my folder
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True '--> i only managed to do it right till here
'supposed to copy range in every sheet of excel in my folder into different workbook
For Each ws In thiswoorkbook.Worksheets '--> i try write this code but i am confused to do what i want from here and i know this code is nowhere near true
With ws
If .Name <> "GABUNGAN" Then
range("A27:AJ500").Select
Selection.copy
Workbooks("Tes.xlsm").range("A27").PasteSpecial Paste:=xlPasteValues
End If
End With
Next ws
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.Goto ActiveWorkbook.Sheets("sheet1").range("A1")
End Sub
I've been searching for the code not only i cant customize it to this code but also i cant understand what is wrong in the code therefore i write this question. Any help will be appreciated, thanks in advance for your attention wish you safe and sound.
Try this: (tested)
Dim sourcewb As Workbook
Dim destwb As Workbook
Dim y As Long
Dim ws As Worksheet
Dim strPath As String, strFilename As String
strPath = "C:\Users\ASUS\Desktop\Done\"
strFilename = Dir(strPath & "*.xlsm")
y = 27
Set destwb = ThisWorkbook
Do While strFilename <> ""
Set sourcewb = Workbooks.Open(Filename:=strPath & strFilename, ReadOnly:=True)
For Each ws In sourcewb.Worksheets
With ws
If .Name <> "name of reference sheet" And .Name <> "name of consolidation sheet" Then
.Range("A27:AJ500").Copy
destwb.Worksheets("sheet1").Range("A" & y).PasteSpecial Paste:=xlPasteValues
y = y + (500 - 27) + 1
End If
End With
Next ws
sourcewb.Close False
strFilename = Dir()
Loop
I am trying to convert this code that instead of saving PDF copies it saves the individual sheets as Excel workbooks instead. I have tried changing the Export as fixed format to xlsm but it appears to have a run time error. Very new to this but any help would be appreciated.
Sub PDF()
Dim xWs As Worksheet
Application.ScreenUpdating = False
For Each xWs In ThisWorkbook.Worksheets
If xWs.Visible = True Then
If xWs.Name <> "HOME" And xWs.Name <> "DATA" Then
xWs.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\PDF P&L\" & Range("G1").Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End If
Next xWs
Application.ScreenUpdating = False
End Sub
The .ExportAsFixedFormat method doesn't support export to excel file formats as per the documentation
The action you're most likely looking for is .move. When not specified with where to move, this will create a new workbook with the moved sheet. You can then use workbooks(Workbooks.count) to access the latest created workbook. See example code below:
Dim wb As Workbook
ActiveSheet.Move
Set wb = Workbooks(Workbooks.Count)
wb.SaveAs Filename:="yournamehere", FileFormat:=xlOpenXMLWorkbookMacroEnabled 'etc...
Please note, when this is done to the last remaining or only sheet in the workbook, this will throw an error. For more info on the .move method, see the link. For file formats to use see here.
Also, when moving a sheet, all the VBA code on the worksheet will be pulled across, but the modules related to the workbook won't. So attempting to save it as anything but xlsm when it has any code on it will result in a prompt or error.
I have a macro which creates a tab, named by a cell - every time I run the macro - this tab has different name. I have to save only this tab as a separate csv file.
For now I have the code below - it saves all 2 tabs to a specified location. I would be really grateful for any ideas how I can manage this !
Dim mySheet As Worksheet
Dim myPath As String
Application.DisplayAlerts = False
For Each mySheet In ActiveWorkbook.Worksheets
myPath = "\\F:\ABC\INPUT\"
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(mySheet.Index).Copy
ActiveWorkbook.SaveAs Filename:=myPath & mySheet.Name, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
Next mySheet
Application.DisplayAlerts = False
In your question, you mentioned "I have a macro which creates a tab, named by a cell", so I am assuming that the tab is created based on the value in that cell. If that is the case, you may simply read the value of that cell in a vba variable. Something like:
Dim tabName as string
tabName = sheets("SheetName").range("A1").value 'if the cell for creating the sheet is A1
Now, use this variable to rename the file generated. Like,
ThisWorkbook.Worksheets(tabName).Copy
ActiveWorkbook.SaveAs Filename:="F:\path\" & tabName & ".csv"