Hi I'm trying to write a macro to select certain worksheets into a new file.
the tricky part is that I want to save all worksheets but 3.
I've managed to select the worksheets but I can't find how to create a new workbook and then save it.
here's my code, the sub stops at Sheets(Array(Selection)).Copy
which is not the correct command.
thanks for you help
Sub ExportPrices()
Dim ExportName As String
Dim ReportingDir As String
Dim Dashboard As String
Dim ws As Worksheet
Dashboard = ThisWorkbook.Name
ExportName = Workbooks(Dashboard).Worksheets("Macro").Range("ExportName").Value
ReportingDir = Workbooks(Dashboard).Worksheets("Macro").Range("ReportingDir").Value
Workbooks(Dashboard).Worksheets("Europe").Select
For Each ws In Worksheets
If ws.Name <> "Macro" And ws.Name <> "Dashboard" And ws.Name <> "Data" Then
ws.Select (False)
End If
Next
'create an array from selection
Sheets(Array(Selection)).Copy
ActiveWorkbook.SaveAs Filename:=ReportingDir & ExportName, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
You must add new workbook and copy target sheet to wb:
Dim oOutBook As Workbook
Set oOutBook = Workbooks.Add
Sheets(Array(Selection)).Copy Before:=oOutBook.Sheets(1)
oOutBook.SaveAs strPathOutput
You can use the .Move method in VBA. When not presented with a location to move to, the .Move method will move the specified sheet into a new workbook.
Sheets("Yoursheet").Move
As this will always be the latest created workbook, you can then refer to this by using Workbooks.Count:
Dim wb As Workbook
Set wb = Workbooks(Workbooks.Count)
Related
I have code that exports sheets from my current sheet to a new sheet.
It works perfectly well until I try to use a password on the SaveAs.
When using a password, and the save is to a OneDrive folder I get two messages when I open the new sheet. One is that the file is opened read only. Second is that the file is locked by another user. Using a password on a non-OneDrive folder does not have these problems.
No Excel programs are runing in Task Manager when the file is showing as in use. This code can be dropped into any new workbook that contains sheets "Sheet1", "Sheet2" and "Sheet3" to demonstrate (or not!) this problem.
Dim wbNew As Workbook
Dim fileSaveName As Variant
Dim i As Integer
Dim wks As Worksheet
Dim strSheetList(2) As String
Dim wbThis As Workbook
strSheetList(0) = "Sheet1"
strSheetList(1) = "Sheet2"
strSheetList(2) = "Sheet3"
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, fileFilter:="Excel Files (*.xlsx), *.xlsx")
Set wbNew = Workbooks.Add(xlWBATWorksheet)
wbNew.SaveAs fileSaveName, Password:="ABC"
'Things tried:
'ReadOnlyRecommended:=False,
'ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
'AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
Set wbThis = ThisWorkbook
For i = 0 To UBound(strSheetList)
Set wks = wbThis.Worksheets(strSheetList(i))
wbThis.Worksheets(strSheetList(i)).Activate
ActiveSheet.Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy
If strSheetList(i) <> "Sheet1" Then
wbNew.Sheets.Add(after:=wbNew.Sheets(wbNew.Sheets.Count)).Name = wks.Name
Else
blnSheet1Exported = True
End If
wbNew.Worksheets(wks.Name).Range("A1").PasteSpecial xlPasteColumnWidths
wbNew.Worksheets(wks.Name).Range("A1").PasteSpecial xlPasteValues
wbNew.Worksheets(wks.Name).Range("A1").PasteSpecial xlPasteFormats
Next i
wbNew.Close True
What is really interesting is that if I comment out the code that writes the sheets (The For Next loop) The problem does not occur.
I have an Excel-File in which the user can click on a button to save a version without formulas and only with values.
So far I use this VBA for it:
Sub Create_version_with_values_only()
Dim b As Worksheet
For Each b In Worksheets
b.Cells.Copy
b.Cells.Cells.PasteSpecial Paste:=xlPasteValues
Next b
Application.CutCopyMode = False
ActiveWorkbook.SaveCopyAs "G:\Folder\test.xlsm"
ThisWorkbook.Close SaveChanges:=False
End Sub
This VBA itself worsk fine.
However, the issue is that I have to close the file after the value-version of the file is created because the original version will not be available anymore.
Therefore, I am wondering if there is an alternative way to create the value-version of the file that makes it possible to go back to the original file afterwards.
Something like this:
Step 1) Change all formulas to values.
Step 2) Save the version with the values in the folder.
Step 3) Undo the value-replacements in original sheet without closing it.
Do you have any idea how to solve it?
There might be a more simple way to get there, but here's how you'd create a new workbook, transfer the values over and save.
Public Sub SaveValues()
Dim newWb As Workbook
Set newWb = Workbooks.Add 'create a new workbook for the values
Dim ws As Worksheet, newWs As Worksheet
For Each ws In ThisWorkbook.Worksheets
With newWb 'create worksheets and name them in new workbook
If ws.Index = 1 Then
Set newWs = .Worksheets(1)
Else
Set newWs = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
End If
newWs.Name = ws.Name
End With
With ws.UsedRange 'move values to new worksheet
newWs.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
Next
'save new workbook. If the current workbook is a .xlsb, change the .xlsm in the code below
newWb.SaveAs Replace(ThisWorkbook.FullName, ".xlsm", "_hardcoded.xlsm"), xlOpenXMLWorkbookMacroEnabled
newWb.Close
End Sub
Updated for alternatives below:
Alternative
An alternative is to use ThisWorkbook.Worksheets.Copy to copying all worksheets in one go. Unfortunately, to use this code, we have to use ActiveWorkbook to make a reference to the new workbook. (I hoped it might return a Workbook or Worksheets object)
Public Sub SaveValues2()
Dim newWB As Workbook
ThisWorkbook.Worksheets.Copy
Set newWB = ActiveWorkbook 'not great practice
Dim ws As Worksheet
For Each ws In newWB.Worksheets
With ws.UsedRange 'hardcode values
.Value = .Value
End With
Next
newWB.SaveAs Replace(ThisWorkbook.FullName, ".xlsm", "_hardcoded.xlsm"), xlOpenXMLWorkbookMacroEnabled
newWB.Close
End Sub
I have a workbook with many sheets. I'm trying to copy two sheets together to a new workbook.
I get
Run-time error 13 for type mismatch.
Sub CopyBillStatandCosts()
Dim MyBook As Workbook
Dim NewBook As Workbook
Set MyBook = ThisWorkbook
Workbooks.Add ' Open a new workbook
Set NewBook = ActiveWorkbook
Set MyBook = ActiveWorkbook
Sheets(11).Copy Before:=Workbooks(NewBook).Sheets(1)
Sheets(9).Copy Before:=Workbooks(NewBook).Sheets(1)
Workbooks(NewBook).Sheet1.Delete
End Sub
Update: I figured out the code. But how do I refer to the sheets by their code names, which is best practice? They are sheet9 and sheet 11.
Sub copyBillStatandCosts()
ThisWorkbook.Worksheets(Array("BillStat", "C")).Copy
End Sub
Your second
Set MyBook = ActiveWorkbook
was probably meant to be
MyBook.Activate
although an overall simpler way to do this would be
Sub CopyBillStatandCosts()
Sheets(Array("BillStat", "Costs")).Copy
End Sub
The Copy with no parameter makes the copy in a new workbook.
Copy Worksheets by Code Name in One Go
Sub copyBillStatandCosts()
ThisWorkbook.Worksheets(Array(Sheet9.Name, Sheet11.Name)).Copy
' To continue to work with the new workbook, do the following:
Dim NewBook As Workbook: Set NewBook = ActiveWorkbook
' e.g.:
' NewBook.SaveAs "C:\Test\Test.xlsx", xlOpenXMLWorkbook
' To continue to work with each new worksheet, do the following:
Dim bws As Worksheet: Set bws = NewBook.Worksheets(1)
Dim cws As Worksheet: Set cws = NewBook.Worksheets(2)
' e.g.:
MsgBox NewBook.Name & vbLf & bws.Name & vbLf & cws.Name
End Sub
Why use code names? Now you can rename the two worksheets in the tabs, and the code will still copy the right ones to a new workbook.
Why in one go? If there are references of the worksheets from one to each other they will still work in the new workbook i.e. will not refer to the worksheets in the source workbook.
If you wanna use programmatic names, then just use Name property:
ThisWorkbook.Sheets(Array(sheet9.Name, sheet11.Name)).Copy
Would appreciate if there's any help anywhere. Let's say, I have the following tabs: Data Set 001, Data Set 002, Data Set 003, so long the tab names contain Data Set, it should copy over to another workbook (let's say Main File). Any help with regards to this is welcomed. Thanks all in advance!
Best Regards,
Josh
I used this in Workbook containing worksheet, "ASSESSMENT FORMxx":
Sub CopyWorksheetsToNewWorkbook()
'This macro is to be in the ActiveWorkbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Add
wb.SaveAs Filename:="Book10" & ".xlsx"
Workbooks.Open ("Book10.xlsx")
For Each ws In Workbooks("ActiveWorkbookName.xlsm").Sheets
If ws.Name Like ("ASSESSMENT FORM*") Then ws.Copy Before:=Workbooks("Book10.xlsx").Worksheets("Sheet1")
Next ws
Workbooks("Book10.xlsx").Worksheets("Sheet1").Move Before:=Workbooks("Book10.xlsx").Sheets(1)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Note that both workbook with worksheet "ASSESSMENT FORMxx" and Book10.xlsx must be open.
Did you have a go at any code?
Sub Whatever()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("AnyOpenWorkbookName.xlsx")
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "Data Set" & "*" Then
Call ws.Copy(after:=wb.Sheets(wb.Sheets.Count))
End If
Next ws
End Sub
You need to loop through all Worksheets of your 1st Workbook, test if its name contains Data set with Worksheet.Name and InStr.
If the InStr function returns something else than 0 (meaning your Worksheet name contains Data Set), you can copy the current Worksheet to the 2nd Workbook.
Adapt this sample to your needs:
'Loop through all worksheets
If InStr(wsCurrent.Name,"Data Set") <> 0 Then
' Copy wsCurrent to new WorkBook
End If
' End of loop
I currently have a master workbook that I use to create external pdf forms. My current code lets me browse to a folder and select another workbook to pull specific data from and paste it into the Master.
The data is copied from external workbook, sheet1, and pasted to active workbook, sheet1. The code I am working with is "For Each Sheet." Works like a charm.
The problem is that I have added another sheet to the workbooks and it's throwing a Run-time error 1004. I need to recode it so it copies from only sheet1 in the external workbook and pastes only to sheet1 of the Master (active).
Any ideas? Thanks for any help you can pass along.
Sub ImportData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Dim sh As Worksheet
Dim strXLSFile As String, strPDFFile As String, strFolder As String
strFolder = "H:\Company Data\Firm Files\Client Data Workbooks\Excel Data-Client Info"
Set wb1 = ActiveWorkbook
Set PasteStart = [Client_Data]
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xlsm (*.xlsm),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each Sheet In wb2.Sheets
With Sheet.Cells.Range("B9:B27")
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet
End If
wb2.Close False
End Sub
if you only want Sheet1 then get rid of the loop.
Instead of:
For Each Sheet In wb2.Sheets
With Sheet.Cells.Range("B9:B27")
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet
Try:
wb2.sheets(1).range("B9:B27").copy PasteStart
it seems like this is a one time use so no need to Set PasteStart = again. Hope this helps