I wrote a simply code to save every Excel Worksheet as a new file (.xlsx) protected with password:
For i = 1 To 7
ThisWorkbook.Sheets(i).Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & i & ".xlsx", FileFormat:=51, Password:="XXX"
ActiveWorkbook.Close False
Next i
It works but the error is that the created files seem to have a sort of autorun (they auto-open if you simply click on the icons) and then the Excel popup about password shows "copy of && is protected" in adding to "&& is protected" and ask for the password twice.
Any ideas?
Thanks
A general peace of advice, do not use ThisWorkbook, ActiveWorkbook, Active Worksheet etc. if not 100% neccessary. It more often than not causes problems. Second thing, sometimes a few more lines of code are better than less, because of debugability.
The most important points of code below: Your workbook of source is defined as wbSource and you initialize a variable wbTarget. For each worksheet in the workbook you create a new workbook by Set wbTarget = Workbooks.Add copy the sheet mySheet the iterator to it, set the password and save it. This can be done in one row, but again this is very clear and debugable.
Sub test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wbSource As Workbook, wbTarget As Workbook
Dim wsToCopy As Worksheet
Set wbSource = ThisWorkbook
For Each mySheet In wbSource.Sheets
Set wbTarget = Workbooks.Add
mySheet.Copy Before:=wbTarget.Sheets(1)
wbTarget.Password = "XXX"
wbTarget.Close True, mySheet.Name
Next mySheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Related
I am trying to open two other Excel workbooks to take data to do my calculation through the macro. I have a working code to open those files.
Dim wbCount As Integer
Application.ScreenUpdating = False
For wbCount = 1 To 2
Workbooks.Open Filename:=ThisWorkbook.Path & "\Installation Sheet " & wbCount & ".xlsm", UpdateLinks:=False
Next wbCount
ThisWorkbook.Activate
Application.ScreenUpdating = True
The other files are named "Installation Sheet 1" and "Installation Sheet 2". After this code runs, I end up with "Installation Sheet 1" displaying instead of my active workbook.
Put your ActiveWorkbook into a variable at the appropriate place and then use that to move back. ThisWorkbook is the one with code in. So be sure if you mean ActiveWorkbook or ThisWorkbook, or if ThisWorkbook is the ActiveWorkbook at the time. In that case, you can simply Set wb = ThisWorkbook
Dim wb As Workbook
Set wb = ActiveWorkbook
'Set wb = ThisWorkbook '<== If you want the workbook containing the code
'Other code
wb.Activate
You have to put your workbooks references into variables and then using these variables you have two options: close newly opened workbook, so only original stays opened or use Activate method to bring the original workbook to front.
Sample code:
Sub OpeningWb()
Dim wb As Workbook, currentWb As Workbook
Set currentWb = ThisWorkbook
Set wb = Workbooks.Open("your path here")
' if you want to close opened workbook
'wb.Close
' if you want to bring to front original workbook
currentWb.Activate
End Sub
Alternatively, you can do the following:
Dim wbToDisplay As Workbook
Set wbToDisdplay = Workbooks("workbook name here")
wbToDisplay.Activate
The above solutions didn't work for me, because activate method is fired before second workbook is displayed, so I get active this second workbook always. My workaround is wait a couple of seconds before calling Activate method:
Dim t: t = Timer
While Timer < t + 2 'wait for 2 seconds
DoEvents
Wend
ThisWorkbook.Activate
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbTarget = ThisWorkbook
Set wbSource = Workbooks.Open("C:\Users\alibe\Desktop\PoS\Alain.xlsx")
wbSource.Worksheets("Spain").Range("plage_sp").Copy
wbSource.Activate
Set wbTarget = ThisWorkbook
wbTarget.Worksheets("Feui1").Range("A1").PasteSpecial xlPasteAll
wbTarget.Save
wbTarget.Close
Hi everybody,
I am trying to cut and paste cells between two different workbooks. But I got failure 9 or 438 in my Paste line. May somebody give a help please.
There's a couple things we want change.
First, it's good practice to get into the habit of having excel check whether your file location exists or not. You might think you have it put in correctly, but it's always best to make sure excel feels the same way. (This also makes your code more flexible for later use.)
When opening workbooks and closing them, there's no reason to bog your system down trying to open new windows quickly. Since we don't need to see what it's doing, just that it's done it, we can turn ScreenUpdating and DisplayAlerts to false until the end of our code.
You should check the spelling on your worksheet "Feui1", that it's not actually "Feuil".
For the application of defining different ranges by workbook, we need to use .Sheets() object instead of .Worksheets()
Also, it's not common to see that you have this code in the same file that you're closing, when you're opening another file. At the end of this routine, ThisWorkbook is going to close, and wbSource will be left open. Is this intentional? Just something I thought I'd point out.
Sub CopyPasta()
Dim wbTarget As Workbook: Set wbTarget = ThisWorkbook
Dim wbSource As Workbook, sourceFile As String
sourceFile = "C:\Users\alibe\Desktop\PoS\Alain.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Dir(sourceFile) = "" Then 'Checks that file location exists
MsgBox "File not found.", vbCritical, "Bad File Address"
Exit Sub
End If
Set wbSource = Workbooks.Open(sourceFile)
wbSource.Sheets("Spain").Range("plage_sp").Copy
wbTarget.Sheets("Feuil").Range("A1").PasteSpecial xlPasteAll 'Spelling on 'Feuil'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
wbTarget.Save
wbTarget.Close 'You want to close the workbook that this code is in?
End Sub
Few changes
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbTarget = ThisWorkbook
Set wbSource = Workbooks.Open("C:\Users\alibe\Desktop\PoS\Alain.xlsx")
wbSource.Sheets("Spain").Range("plage_sp").Copy
wbTarget.Sheets("Feui1").Range("A1").PasteSpecial Paste:=xlPasteAll
wbTarget.Save
wbTarget.Close
It seems a normal question and I have searched and tried many suggestions here but the error persists. I want to copy a "case1" sheet from current workbook to an existing workbook(file name is "workbook2.xlsx", it has a worksheet named "case2"), then save the workbook and close it. Sometimes it works well, but most of the time I kept getting the same error. In fact I did not change any code so I don't know where went wrong.
The error shows "The object invoked has disconnected from its clients". It always breaks in the same place:
ThisWorkbook.Sheets("case1").Copy Before:=ActiveWorkbook.Sheets("Case2")
Sub CopySheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'open existing "workbook2.xlsx"
Workbooks.Open filename:="c:\workbook2.xlsx"
'copy a sheet named "case1" from current workbook to "workbook2.xlsx" which already has a sheet named "case2"
ThisWorkbook.Sheets("case1").Copy Before:=ActiveWorkbook.Sheets("Case2")
'close "workbook2.xlsx"
Workbooks("workbook2.xlsx").Activate
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Always set references to sheets and workbooks, then there is no chance of confusing which is which. This code does the same thing and should not give you any errors.
Sub CopySheet()
Dim wb1 As Workbook, ws1 As Worksheet 'Source
Dim wb2 As Workbook, ws2 As Worksheet 'Target
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("case1")
Set wb2 = Workbooks.Open("c:\workbook2.xlsx")
Set ws2 = wb2.Sheets("case2")
ws1.Copy Before:=ws2
wb2.Close True
End Sub
I need help saving specific tabs from excel workbooks as 1) csv files, and 2) files named after the file from which they originate.
So far I have this which works in taking out the right tab from a single workbook and saving it as a .csv file.
Sub Sheet_SaveAs()
Dim wb As Workbook
Sheets("SheetName").Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Path & "\SheetName.csv"
'.Close False
End With
End Sub
How do I rename "SheetName" so that the file saves as, for example, Workbook1SheetName, Workbook2SheetName etc.?
I want to loop this function through a folder of many, many excel files, so unique names are necessary for the new .csv files.
I found this online which shows how to use a VBA loop, http://www.ozgrid.com/VBA/loop-through.htm. In theory it should work with my code above as long as each .csv file can have a unique name. Correct me if I am wrong.
Thanks for the help.
As you've discovered, when you copy a worksheet with no destination you end up with a new workbook populated by the copy of worksheet. The new workbook becomes the ActiveWorkbook property in the VBA environment. To save the workbook as a CSV file you need to retrieve the Worksheet .Name property of the sole worksheet in that new workbook.
Sub All_Sheet_SaveAs_CSV()
Dim w As Long, wb As Workbook
Dim fp As String, fn As String
On Error GoTo bm_Safe_Exit
'Application.ScreenUpdating = False 'stop screen flashing
Application.DisplayAlerts = False 'stop confirmation alerts
'start with a reference to ThisWorkbook
With ThisWorkbook
fp = .Path
'cycle through each of the worksheets
For w = 1 To Worksheets.Count
With Worksheets(w)
.Copy
'the ActiveWorkbook is now the new workbook populated with a copy of the current worksheet
With ActiveWorkbook
fn = .Worksheets(1).Name
.SaveAs Filename:=fp & Chr(92) & fn, FileFormat:=xlCSV
.Close savechanges:=False '<~~ already saved in line above
End With
End With
Next w
End With
bm_Safe_Exit:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Note that turning .DisplayAlerts will turn off the warnings that you would normally receive. While this is helpful with the CSV file format, it also will not warn you if you attempt to overwrite a file.
The Workbook.SaveAs method with a file format parameter of xlCSV will supply the correct file extension. There is no need to include it as part of the filename.
If a limited number of specific worksheets are intended to receive the export-to-CSV procedure, then an array of worksheet names could be cycled through rather than the worksheet index position.
Sub Specific_Sheets_SaveAs_CSV()
Dim v As Long, vWSs As Variant
Dim fp As String, fn As String
On Error GoTo bm_Safe_Exit
'Application.ScreenUpdating = False 'stop screen flashing
Application.DisplayAlerts = False 'stop confirmation alerts
vWSs = Array("Sheet1", "Sheet3", "Sheet5")
'start with a reference to ThisWorkbook
With ThisWorkbook
fp = .Path
'cycle through each of the worksheets
For v = LBound(vWSs) To UBound(vWSs)
With Worksheets(vWSs(v))
.Copy
'the ActiveWorkbook is now the new workbook populated with a copy of the current worksheet
With ActiveWorkbook
fn = .Worksheets(1).Name
.SaveAs Filename:=fp & Chr(92) & fn, FileFormat:=xlCSV
.Close savechanges:=False '<~~ already saved in line above
End With
End With
Next v
End With
bm_Safe_Exit:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I have a function that is meant to run the ShowPages() command of a PivotTable and then save each sheet to a separate file.
Here's how I wish I could do it:
Sub Split()
ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
Dim newWb As Workbook
For Each s In ThisWorkbook.Sheets
If s.Name <> "Data" Then
Set newWb = s.Move #This is the line I'm trying to work out
newWb.SaveAs Filename:="C:\Export\" + s.Name + ".xls"
newWb.Close
End If
Next s
End Sub
Unfortunately, this is running into a bunch of issues to do with not having created objects and suchlike (understandably). What is the most sensible way to do this?
Sub Split()
ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
Dim newWb As Workbook
For Each s In ThisWorkbook.Sheets
If s.Name <> "Data" Then
''Added by Soldieraman
Dim sheetName As String
sheetName = s.Name
Set newWb = Workbooks.Add
s.Move before:=newWb.Sheets(1)
Application.DisplayAlerts = False
newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
''Edited by soldieraman
newWb.SaveAs Filename:="C:\Export\Test" & sheetName & ".xls"
newWb.Close
End If
Next s
End Sub
Although this is old, and the accepted answer by soldieraman is very nice, just wanted to add one thing. The Excel VBA Sheets.Copy and Sheets.Move methods have a very nice feature. They take either of two optional arguments, "Before" or "After", to position a moved/copied sheet. The Excel documentation notes that:
If you don't specify either Before or After, Microsoft Excel
creates a new workbook that contains the moved [copied] sheet.
So, it is almost surprising, but you can just say:
Sheets(sheetname).Move
in the accepted answer, in place of:
Set newWb = Workbooks.Add
s.Move before:=newWb.Sheets(1)
Application.DisplayAlerts = False
newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
The rest of soldieraman's code would work fine with this simplification.