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
Related
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
Background:
I have two workbooks in the same directory with different sheets in each one of them.
I would like to open book2.xlsx, execute a VBA, to copy the whole content from "sheet1" in book1.xls. After this, the book1.xls should be closed automatically.
I have a code, which is moving the content next to a sheet, then I have to rename this sheet to the desired one. The problem with this is one is I the formulas in the other sheet will not work as desired. The code is as follows,
Sub XLVBACopyFiles()
Dim MonthlyWB As Variant
Dim FileName As String
FileName = ActiveWorkbook.Name
Path = ActiveWorkbook.Path & "\"
Application.DisplayAlerts = False
Application.EnableEvents = False
'Copy the sheet1 next to sheet2 in the current workbook
Application.Workbooks.Open (Path & "book1.xls")
Sheets(Array("sheet1")).Select
Sheets("sheet1").Activate
Sheets(Array("sheet1")).Move After:=Workbooks( _
FileName).Sheets("sheet2")
Application.EnableEvents = True
Application.DisplayAlerts = True
Workbooks(FileName).Save
' Workbooks(FileName).Close
End Sub
Any help with this would be highly appreciated.
If what you want , according to your comment above, is paste the content to "sheet2 itself", update the code above :
Application.Workbooks.Open (Path & "book1.xls")
Sheets(Array("sheet1")).Select
Sheets("sheet1").Activate
**Sheets(Array("sheet1")).Move After:=Workbooks( _
FileName).Sheets("sheet2")**
to
Application.Workbooks.Open (Path & "book1.xls")
Sheets(Array("sheet1")).Select
Sheets("sheet1").Activate
'Next 2 lines will select the range of content to be copied, and CTRL+C it. Edit it to your desire range
Range("A1:A5").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select ' In this line you should choose which cell to start pasting
ActiveSheet.Paste
Also, to close workbook, use:
Workbooks("book1.xls").Close SaveChanges:=True
Pay attention to SaveChanges option, choose True/False if you want to save or not this workbook
I am trying to create some coding to be used across several workbooks. Within the workbooks I want to update certain sheets. These specific sheets are always in the same exact format and I want to update the same exact cells every time.
I am trying to create a loop and the "Do While" coding looks at the sheet need to determine if it needs to loop or not.
Below is the code I am using, and I keep getting the run time error '424': object required in vba. Where I will put the rest of my coding I have a msgbox there as a place holder just to get the code to work.
Do While WS.Name Like "P&L - "
If Range("S306") <> 0 Then
MsgBox ("tEST GOOD")
Worksheets(ActiveSheet.Index + 1).Select
End If
Loop
Perhaps something like this?
Sub tgr()
Dim wb As Workbook
Dim ws As Worksheet
'Loop through each currently open Excel workbook
'If you instead need to loop through files in a folder, code would be different
For Each wb In Application.Workbooks
'loop through all sheets in one of the workbooks
For Each ws In wb.Worksheets
'Compare the worksheet name and cell S306 value
If ws.Name Like "P&L - *" _
And ws.Range("S306") <> 0 Then
'Match found, your code would go here
MsgBox "Workbook: " & wb.Name & Chr(10) & _
"Worksheet: " & ws.Name
End If
Next ws
Next wb
End Sub
(Beginner VBA coder here!)
Does anyone know how to extract multiple, specific cell data from multiple closed workbooks that have the same worksheet format?
I am currently tasked to copy very specific data from certain cells from many different and new (but same format) sources and transfer them into another group of specific cells in an existing masterlist with different worksheets.
This is the code I wished would help, but it is lacking in too many ways as compared to what I need...
Sub Importsheet()
Dim Importsheet As Worksheet
'import worksheet from a closed workbook
Sheets.Add Type:= _
'e.g. directory below
"C:\Users\Loli\Desktop\Testing1.xlsx"
End Sub
This code helps me get the sheets out of the closed source workbook but not the specifically placed cells in the closed source excel. It also can't paste the data in specifically placed cells in different sheets in the destination excel.
It is very difficult to completely understand your requirements as it seems like sometimes you want to copy a range and some other times a single cell, so to point you in the right direction my answer only shows how to open and copy the relevant Sheet into your master workbook to then be able to reference the cell/ranges you want
(I would once you get your data then delete the Worksheet, so that your master doesn't suddenly becomes massive in size):
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook") 'open dialog to choose the file you want, you can change this to loop through a folder if they are all in there.
If sImportFile = "False" Then 'check if a file was selected before importing
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile 'open the selected file
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("Raw_Data") Then ' you should change this to the date, you can do this easily by using a variable such as if SheetExists(variableDate) then, where variableDate = "12/12/2017" or something similar
Set wsSht = .Sheets("Raw_Data")
wsSht.Copy before:=sThisBk.Sheets("Sheet1") 'copy the worksheet into your master
'WsSht.range("A1:B2").copy Destination:=sThisBk.Sheets("Temp").Range("A1").paste xlpastevalues 'use this to copy a specified range in this case A1:B2 to a sheet in master workbook called Temp A1
Else
MsgBox "There is no sheet with name :Raw_Data in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function
The following code results in an .xls with the 2 worksheets I want. Only I don't end up with just values.. the formatting is in there (and I don't think it should be. paste. values. dammit.), and the .xls has a unbreakable link to the original document that doesn't need to be there (and I'm thinking shouldn't be there). All the cells only contain values and do not contain any of the equations contained in the source workbook.
When I open the newly created .xls I receive the message "the file format and extension of [ws name].xls don't match. The file could be corrupted or unsafe. Unless you trust its source, don't open it. do you want to open it anyway?"
I loathe the lack of trust.. :)
What am I doing wrong?
Sub QUOTE_ITEM_OUTPUT()
Dim ws As Worksheet
Dim Filename As String
Dim Filelocation As String
Dim UserName As String
Dim Password As String
Filename = Worksheets("CALCULATION PAGE").Range("ITEMNUM").Value & "_" & Worksheets("CALCULATION PAGE").Range("PDFSAVEREV").Value & ".xls"
Filelocation = "\\GSWGS\Apps\Global\FILES\Import\GWS-Upload-TST\"
With Application
.ScreenUpdating = False
' Copy specific sheets
Sheets(Array("ITEM OUTPUT", "ROUTING")).Copy
' Paste sheets as values
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
ActiveWorkbook.SaveCopyAs Filelocation & Filename
ActiveWorkbook.Close SaveChanges:=False
.ScreenUpdating = True
End With
End Sub
You are saving as .xls file, but have not specified that file format in the saveAs method. That's why you are getting security warnings...
You need to specify that parameter in the SaveAs method.
ActiveWorkbook.SaveAs Filename:=Filelocation & Filename, FileFormat:=56
Here is a link to MSDN page for the various fileFormat parameters:
https://msdn.microsoft.com/en-us/library/office/ff198017.aspx
EDIT - for second problem you face:
As for the fact that formats are being carried across, that is because you are not using the correct Enumeration value.
ws.[A1].PasteSpecial Paste:=xlValues
should be:
ws.[A1].PasteSpecial Paste:=xlPasteValues
Use another sub to 'cleanse' the sheet
Sub ApplyValuesTo(ByVal sh As Excel.Worksheet)
For Each cell In sh.UsedRange.Cells
With cell
.Value = .Value
'// This may take a while; the next line will allow you to manually
'// break if needed (e.g. If you have a lot of data in the sheet)
DoEvents
End With
Next
End Sub