I am trying to extract a selection of worksheets from a workbook; worksheets whose names contain the string: "STRINGY", and export those worksheets as one single pdf. The code below creates a blank pdf.
Sub Test()
Application.CutCopyMode = False
For Each sht In ActiveWorkbook.Worksheets
If InStr(1, sht.Name, "STRINGY") > 0 Then
Sheets(sht.Name).Select Replace:=False
End If
Next sht
Selection.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\File.pdf"
Any help would be greatly appreciated.
You were along the right lines, but didn't use the Selection correctly. The following should do what you need:
Option Explicit
Sub Test()
Dim arrSheets() As String
Dim sht As Worksheet
Dim i As Integer
i = 0
For Each sht In ActiveWorkbook.Worksheets
If InStr(1, sht.Name, "STRINGY") > 0 Then
ReDim Preserve arrSheets(i)
arrSheets(i) = sht.Name
i = i + 1
End If
Next sht
ThisWorkbook.Sheets(arrSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\File.pdf", _
OpenAfterPublish:=True
End Sub
Basically, you need to add the sheets whose name contain your search string in an array and select them all at the same time. Then use that selection as the basis for the export to PDF.
I added the OpenAfterPublish export option so that the file opens in your PDF reader after export; it's not a requirement.
The above code has been successfully tested with Excel 2010, but can't be certain it'll work in Excel 2007 or previous. Notice that an error will occur if the PDF add-in is not currently installed. If that's the case, you can find it at http://www.microsoft.com/downloads/details.aspx?familyid=4d951911-3e7e-4ae6-b059-a2e79ed87041.
Related
I'm looking for assistance regarding how to write a VBA command that allows me to copy a range of cells from different workbooks onto one master sheet. Let me explain further.
Everyday I receive a new excel document from my clients named based on the date it was uploaded ie. September 18, 2018 file would be called A20180918.
Once i've received a week's worth of excel files (A20180918-A20180921), I then have to copy certain information from the original uploaded file to a master tracking sheet.
So, my hurdle is such that each time I record my actions into a macro, the code includes the file name which then creates a subscript error when it's run on the next day's file.
So here's an example below of the code I have this far:
Sub CopyRange()
CopyRange Macro
'This is the line of the code that's causing problems given it's a specified workbook name
'and when I try to open tomorrow's workbook i'll run into the subscript error.
Windows("A20180914.xls").Activate
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Master Sheet.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Thank you!
Here's two solutions. One to scan an Directory for files, and the other to select files. I see they've both been suggested in the comments already. :p
Sub Test()
' If you want to scan an "unprocessed files" directory
'Call ScanDir("C:\Test\")
' If you want to select files to process
Call SelectFiles
End Sub
Private Sub ScanDir(ByVal DirPath As String)
Dim oCurFile As String
oCurFile = Dir(DirPath)
Do While oCurFile <> ""
' Add the work to the file here
' Filename: DirPath & oCurFile
oCurFile = Dir()
Loop
End Sub
Private Sub SelectFiles()
Dim oFileDialog As FileDialog
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
oFileDialog.AllowMultiSelect = True
If oFileDialog.Show = -1 Then
Dim oFile As Variant
For Each oFile In oFileDialog.SelectedItems
' Add the work to the file here
' Filename: oFile
Next
End If
End Sub
By the looks of it you have all the workbooks open when you run the code - there are ways to have the code open each workbook in a certain folder, or ask the user to select them.
While writing this other answers have given the code for selecting files from folders.
Each workbook in the Excel Application is held in a collection of workbooks. The good thing about collections is you can step through them without know the specifics before you get there.
The code below will print the name of each workbook you have open into the immediate window. Note - these are in the same instance of Excel. If you open Excel a second time then any workbooks in that application will be in a different collection.
You don't really need the Application but I left it in to make things a bit clearer.
Sub Test()
Dim bk As Workbook
For Each bk In Application.Workbooks
Debug.Print bk.Name
Next bk
End Sub
This is the full code - note that nothing is Selected.
Sub Test()
Dim bk As Workbook
Dim Master As Workbook
Dim LastCell As Range
Set Master = Workbooks("Master Sheet.xlsm")
For Each bk In Application.Workbooks
'Checks the middle part of the file name - should be a number.
'Better ways to check the file name are available.
If IsNumeric(Mid(bk.Name, 3, 8)) Then
'Copy date from Sheet1. It's assumed each row in
'column B is populated and figures out the last cell from there.
With bk.Worksheets("Sheet1")
Set LastCell = .Cells(.Rows.Count, 2).End(xlUp)
.Range("A1", LastCell).Copy
End With
'Pastes the results to Sheet1 in the Master workbook.
'The last cell containing data in column A is found and
'then offset by 1 row.
With Master.Worksheets("Sheet1")
.Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
End If
Next bk
End Sub
This will do it, you just need to supply the sheet name and ranges where noted:
Sub copyRange()
'File system variables
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim myDir As String
Dim Mask As String
'Workbook variables
Dim wb As Workbook
Dim sh As Worksheet
myDir = "C:\Users\Guest\Desktop" 'Insert the path where your incoming files are stored.
Mask = "*.xl??" 'This makes it so it only looks at Excel files.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(myDir)
For Each objFile In objFolder.Files
If LCase(objFile.Name) Like LCase(Mask) Then
Set wb = Workbooks.Open(myDir & "\" & objFile.Name, , True) 'This is set to open in read only, to avoid issues with the file already being open
'The ranges you are copying/pasting are vague, supply the sheet names and ranges below
'Get Copy range with dynamic number of rows.
With wb.Sheets("Sheet1").Range("A2:B2") '<---- Specify Sheet/Range
Set copyRange = .Resize(.End(xlDown).Row, 2)
End With
'Get next available row in paste range.
With ThisWorkbook.Sheets("Sheet1").Range("G:H") '<---- Specify Sheet/Range
Set pasteRange = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
copyRange.Copy pasteRange
wb.Close False
End If
Next objFile
End Sub
Current Situation
My Excel workbook contains anywhere from 10 to 32 worksheets used as templates. It also contains 1 worksheet called "Report". I currently loop through all template worksheets and put the information into the Report worksheet, then I create a PDF using that report worksheet.
However this creates 1 PDF per template because it passes through my Report worksheet.
Everytime I send the information to my Report worksheet, that gets turned into a PDF. The problem with that is it generates a PDF everytime my report worksheet gets filled in. I am not exporting my templates as PDF.
Code
Here's the code that generates 1 PDF file per template:
Sub CreatePDF()
Dim currentSerialNumber As String 'Worksheet name is the same as the serial number
Dim ws As Worksheet
Dim pdfFilePath As String
'Create a report for each serial number written in the Summary worksheet and export it to PDF
For i = 10 To Rows.Count 'Start at row #10
If IsEmpty(Worksheets("Summary").Range("B" & i).Value) = False Then
'Do work
currentSerialNumber = Worksheets("Summary").Range("B" & i).Value 'Fetches the serial number
pdfFilePath = "C:\" & currentSerialNumber & ".pdf" 'Ex: C:\1000.pdf
Worksheets(currentSerialNumber).Activate 'Activate the template for this current serial number
GenerateReport (currentSerialNumber) 'Put all the info from the template of this serial # into the report worksheet
Set ws = Worksheets("Reports") 'Set ws object as the report worksheet
ws.UsedRange.Select
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfFilePath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
'No more serial numbers found, exit this loop
Exit For
End If
Next i
End Sub
Goal
I want to loop through each template, send the information to my report, add that report information as a page in a PDF file, and repeat until no more templates.
The similar question linked would work if I was printing all my templates. But I'm actually sending my template information to a more professional, sleek looking report Worksheet. The report is then the one that I want into a PDF. The problem is, I only have one report worksheet that gets filled in by multiple templates.
Is this possible using VBA in Excel?
I think you can handle this in a loop. My idea is to do the following:
After copying the data to the "Report" sheet, create a Copy of that sheet in a new workbook. This new workbook will contain each of the "Report" sheets, and then you can export the entire new workbook
I haven't tested it, but let's try something like this:
Sub CreatePDF()
Dim currentSerialNumber As String 'Worksheet name is the same as the serial number
Dim ws As Worksheet
Dim pdfFilePath As String
Dim reports As Workbook
'## Add a new workbook an
Set reports = Workbooks.Add
ThisWorkbook.Activate
Do Until reports.Worksheets.Count = 1
reports.Worksheets(reports.Worksheets.Count).Delete
Loop
'Create a report for each serial number written in the Summary worksheet and export it to PDF
For i = 10 To Rows.Count 'Start at row #10
If IsEmpty(Worksheets("Summary").Range("B" & i).Value) = False Then
'Do work
currentSerialNumber = Worksheets("Summary").Range("B" & i).Value 'Fetches the serial number
pdfFilePath = "C:\" & currentSerialNumber & ".pdf" 'Ex: C:\1000.pdf
Worksheets(currentSerialNumber).Activate 'Activate the template for this current serial number
GenerateReport (currentSerialNumber) 'Put all the info from the template of this serial # into the report worksheet
Set ws = Worksheets("Reports") 'Set ws object as the report worksheet
'## Copy the Reports sheet to the new workbook
ws.Copy After:=reports.Worksheets(reports.Worksheets.Count)
Else
'No more serial numbers found, exit this loop
Exit For
End If
Next i
'## There is an empty worksheet in the Reports file, so we can remove it:
reports.Worksheets(1).Delete
'## select all sheets in reports:
reports.Worksheets.Select
'## Export the entire file as fixedformat:
reports.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfFilePath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
I am trying to come up with code that will make copies of all the worksheets in a given workbook. Seems simple enough, right? A little Google searching and I cobbled together the following code:
Sub Commandbutton1_click()
Dim Cnt As Long
Dim i As Long
Dim Sht1 As String
Dim MyChoice As String
Dim MyFile As String
Dim CurrWorkBook As Excel.Workbook
Dim Month As String
'Instructional message box
MsgBox "When the 'Open' dialog appears, select the workbook containing the worksheets you want to split and then click Ok."
'Get file name
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Show
MyChoice = .SelectedItems(1)
End With
Application.ScreenUpdating = False
MyFile = Dir(MyChoice)
Set CurrWorkBook = Workbooks.Open(Filename:=MyFile)
CurrWorkBook.Activate
Cnt = Sheets.Count
InputMsg = "Enter the month of the EOM Budget Review:"
InputTitle = "Month"
Month = InputBox(InputMsg, InputTitle)
For i = 1 To Cnt Step 1
Sht1 = Sheets(i).Name
Sheets(Array(Sht1)).Copy
ActiveWorkbook.SaveAs Filename:=Sht1 & " - " & Month & " EOM Budget Review.xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Next i
CurrWorkBook.Save
CurrWorkBook.Close
Application.ScreenUpdating = True
End Sub
It works perfectly...except when it doesn't. In some workbooks, it will copy every sheet with no difficulty. In some workbooks, it will copy some of the sheets, but throw the "Copy method of Sheets class failed" unless you have it skip certain sheets. I have not been able to figure out what the sheets it will not copy have in common. Is there some way I can improve this code? Are there certain features of worksheets that will cause this kind of code to fail inevitably?
Solved thanks to Alex P.'s comment above. I copied the following code from another forum:
Sub UnhideAll()
Dim WS As Worksheet
For Each WS In Worksheets
WS.Visible = True
Next
End Sub
Then I used Call UnhideAll right after Application.ScreenUpdating = False. I also used CurrWorkBook.Close savechanges:=False at the end so that the workbook being copied would not be saved and its hidden worksheets would go back to being hidden.
I have a macro that selects worksheets to be printed from worksheets that carry a value in cell A1.
I am trying to adjust the code so that it will print the pdf file with a predetermined name, eg "Output.pdf" and into the folder that the excel file is currently saved
I do not have the VBA skills to do it - I have been trying to find code in various forums, without luck.
My code currently is:
Sub Print_All_Worksheets_With_Value_In_A1()
Dim Sh As Worksheet
Dim Arr() As String
Dim N As Integer
N = 0
Application.ActivePrinter = "Adobe PDF on Ne07:"
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Visible = xlSheetVisible And Sh.Range("A1").Value <> "" Then
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = Sh.Name
End If
Next
With ActiveWorkbook
.Worksheets(Arr).PrintOut
End With
End Sub
Any help with refining this area i n particular will be greatly appreciated
With ActiveWorkbook
.Worksheets(Arr).PrintOut
I have a slightly different idea for how to do this.
You have created an array of worksheets with Arr variable. I think instead of this:
With ActiveWorkbook
.Worksheets(Arr).PrintOut ...
End With
Do this:
Dim path as String
'Capture the path of the current workbook
path = ActiveWorkbook.Path & "\"
'The copy method will create a NEW workbook with these sheets
ActiveWorkbook.Worksheets(arr).Copy
'The NEW workbook is now "Active", so use ActiveWorkbook and exportAsFixedFormat
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, path & "output.pdf"
'Closes the temporary workbook without warning
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
I am working on writing a VBA code to export some of the sheets in excel to same PDF. I have several chart sheets in my excel file each of which name ends with "(name)_Chart".
I want to export all sheets with names ending wioth chart to one PDF file.
Here is the code I am trying to write.
Sub FindWS()
'look if it at least contains part of the name
Dim s As Worksheet
Dim strPath As String
strPath = ActiveWorkbook.Path & "\"
For Each s In ThisWorkbook.Sheets
If InStr(1, s.Name, Chart) Then
s.Activate
ActiveSheet.ExportAsFixedFormat xlTypePDF, strPath & s.Name & ".pdf"
Exit Sub
End If
Next s
End Sub
This code is not limting export to only the chart sheets but exporting thy whole workbook. Can anyone help me with figurint out whats is missing in my code.
Thanks!
MODIFIED CODE:
Sub FindWS()
'look if it at least contains part of the name
Dim s As Worksheet
Dim strPath As String
strPath = ActiveWorkbook.Path & "\"
For Each s In ThisWorkbook.Worksheets
If InStr(1, s.Name, "Chart") = 0 Then
' Hide the sheet so it is not exported as PDF
s.Visible = False
End If
Next s
With ActiveWorkbook
.ExportAsFixedFormat xlTypePDF, strPath & "TEST.pdf"
End With
End Sub
I am surprised that your code is running in the first place :) You should have actually got an error run time error '13', type mismatch
Sheets and Worksheets are two different things in Excel
The Worksheets collection is a collection of all the Worksheet objects in the specified or active workbook. Each Worksheet object represents a worksheet. Whereas the Sheets collection, on the other hand, consist of not only a collection of worksheets but also other types of sheets to include Chart sheets, Excel 4.0 macro sheets and Excel 5.0 dialog sheets.
So if you declare your object as Worksheet
Dim s As Worksheet
Then ensure that while looping you loop through the correct collection
For Each s In ThisWorkbook.Worksheets
and not
For Each s In ThisWorkbook.Sheets
else you will get a run time error '13', type mismatch
FOLLOWUP (Based on Comments)
# Siddharth: 1. Yes, I want to export Chart sheets that ends with name "Chart". 2. I want all those charts in one PDF and the name of the PDF should be the "original" file name. (I will have to save the final PDF files in different location so there will be no overlapping of files.) – datacentric
Option Explicit
Sub Sample()
Dim ws As Object
Dim strPath As String, OriginalName As String, Filename As String
On Error GoTo Whoa
'~~> Get activeworkbook path
strPath = ActiveWorkbook.Path & "\"
'~~> Get just the name without extension and path
OriginalName = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))
'~~> PDF File name
Filename = strPath & OriginalName & ".pdf"
'~~> Loop through Sheets Collesction
For Each ws In ActiveWorkbook.Sheets
'~~> Check if it is a Chart Sheet and also it ends in "Chart"
If ws.Type = 3 And UCase(Right(Trim(ws.Name), 5)) = "CHART" Then
ws.Visible = True
Else
ws.Visible = False
End If
Next ws
'~~> Export to pdf
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, Filename
LetsContinue:
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
This code will look through all the sheets. If the sheet name doesn't match it will hide it. When it's finished that it exports all visible sheets into one PDF. Make sure yuo don't save the Excel file afterwards or the sheets will remain hidden.
Of course this code is not tested so if you have issues ask back (or try and resolve themself as you may learn something)
Sub FindWS()
'look if it at least contains part of the name
Dim s As Worksheet
Dim strPath As String
strPath = ActiveWorkbook.Path & "\"
For Each s In ThisWorkbook.Sheets
If InStr(1, s.Name, "Chart") = 0 Then
' Hide the sheet so it is not exported as PDF
s.Visible = False
End If
Next s
' Export all sheets as PDF
ActiveSheet.ExportAsFixedFormat xlTypePDF, strPath & "TEST.pdf"
End Sub