I looked here and tried many solutions but could not get my code run as expected.
I have one macro enabled workbook with one module on a sheet named "Original"
I created have a second sheet as master where a add a button to copy the the "original" sheet and save the copy as macro enabled.
When I open the copied file the macro still refer to the initial file. I want the macro be just in the copied file because I cannot distribute the source file to the users.
Following is my code
==>How i copy the file
Sub createNew(fineName As String)
Dim mybook As Workbook
Set mybook = ThisWorkbook
Set newBook = Workbooks.Add
mybook.Sheets("Original").Copy Before:=newBook.Sheets(1)
Set newWs = newBook.Sheets("Original")
newWs.Name = Left(fineName, 30)
End Sub
==>How I save the file
Sub savefile(fname As String, compid As Long)
fname = "PS_" & fname
Set newBook = ActiveWorkbook
Application.DisplayAlerts = False
newBook.SaveAs fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
closefile newBook
End Sub
I will appreciate your help!
Thank you all. I could solve the problem. Thanks to your comments I realized I had I had to copy the module to the newly copied file
Sub CopyOneModule()
Dim FName As String
With Workbooks("Book2")
*** FName = .Path & "\code.txt"
*** .VBProject.VBComponents("Module1").Export FName
End With
Workbooks("book1").VBProject.VBComponents.Import FName
End Sub
Related
I would like to browse to the specific excel file and copy sheet1 of the file which is opening into the new sheet in my xlsm file. I have written the code like below:
Option Explicit
Sub test_copy_sheet()
Dim path As String
Dim filetoopen As Variant
Dim openwb As Workbook
filetoopen = Application.GetOpenFilename()
If filetoopen <> False Then
Set openwb = Application.Workbooks.Open(filetoopen)
openwb.Sheets(1).Copy
ThisWorkbook.Sheets.Add.Name = "mysheet"
ThisWorkbook.Sheets("mysheet").PasteSpecial xlPasteValues
openwb.Close False
End If
End Sub
When i ran the code, it get the issue as photo
I just want to copy sheet1 of the file opening to sheet name "mysheet". Could you please assist on this ?
As mentioned in the comments, please insert Option Explicit at the top of the module to ensure you declare all variables properly (and also pick up typo like thisworkbook and OpenBook)
Try this code below, it will open the file, copy the first sheet to ThisWorkbook and rename to mysheet:
Sub test_copy_sheet()
Dim filetoopen As Variant
Dim openwb As Workbook
filetoopen = Application.GetOpenFilename()
If filetoopen <> False Then
Set openwb = Application.Workbooks.Open(filetoopen, ReadOnly:=True)
openwb.Sheets(1).Copy ThisWorkbook.Sheets(1)
ThisWorkbook.Sheets(1).Name = "mysheet"
openwb.Close
End If
End Sub
Note: You will need to add additional check to be sure that ThisWorkbook does not have a sheet named mysheet. (i.e. no duplicate names)
I would like to loop through all excel workbooks in a folder and write the string "Test" in Cell A1 of every sheet of every workbook.
The following code results in 'Subscript out of Range(Error 9)'.
When I ran the code line by line it turned out the Error is caused by the
line:
Workbooks(FName).Close Savechanges:=True Dir("C\...") stored in FName returns just the file name so the error can't be because of giving the full path name to Workboooks(...).Close which seems often to be the reason for the error.On top of that this code really opens the workbook instead of just writing into it. I don't want it
to open visually.
Sub multWB()
Dim FName As String
Dim wb As Workbook
Dim sht As Worksheet
Dim directory As String
directory = "C:\Users\...\Desktop\multipleWorkbooks\"
FName = Dir("C:\Users\...\Desktop\multipleWorkbooks\*.xls*")
Do While FName <> ""
Set wb = Workbooks.Open(directory & FName)
For Each sht In wb.Worksheets
sht.Cells(1, 1) = "Test"
Next
FName = Dir
Workbooks(FName).Close Savechanges:=True 'causes error
Loop
Set wb = Nothing
End Sub
You already have a reference to the workbook with wb. Just use that reference!
wb.Close SaveChanges:=True
Anything else is dereferencing objects for no reason.
You are retrieving the name of the next workbook before closing the current open one. Switch the order those two lines of code:
Workbooks(FName).Close Savechanges:=True
FName = Dir()
This: FName = Dir is missing the folder name. Change it to this:
FName = directory & Dir()
I am trying to copy a sheet and after this, open the copy to change the first sheet's name.
This is the code inserted on Module1:
Sub CopiarNovaPlanilha()
Dim wkb As Workbook
ActiveWorkbook.SaveCopyAs "I:\CGP\DEOPEX\01 - Supervisão\10 - Alocação das equipes\Consulta Alocados\ALOCACAO TECNICOS.xlsx"
Set wkb = Workbooks.Open("I:\CGP\DEOPEX\01 - Supervisão\10 - Alocação das equipes\Consulta Alocados\ALOCACAO TECNICOS.xlsx")
wkb.Sheets(1).Name = "FUNCIONARIOS"
End Sub
The first part of the Sub to save a copy works perfectly. Although when I try to run the second part it gives me the following error:
Run-time error 1004: Excel cannot open the file
And it says that it can't understand the extension .xlsx or that maybe the file is corrupted, but I've checked and the file is ok.
Does anyone knows which problem is that?
This works for me
Private Sub derp()
Dim wbk As Workbook
Dim path As String
path = "C:\Users\dcoats\Desktop\Book1.xlsx"
Set wbk = Workbooks.Open(path)
wbk.Sheets(1).Name = "FUNCIONARIOS"
End Sub
So maybe check your string thats the path to your workbook?
EDIT
I just tried this and it works as well.
Private Sub derp()
Dim wbk As Workbook
Dim path As String
path = "C:\Users\dcoats\Desktop\CGP\DEOPEX\01 - Supervisão\10 - Alocação das equipes\Consulta Alocados\Book1.xlsx"
Set wbk = Workbooks.Open(path)
wbk.Sheets(1).Name = "FUNCIONARIOS"
End Sub
And I just tried this as well
Private Sub derp()
Dim wbk As Workbook
Dim path As String
path = "C:\Users\dcoats\Desktop\CGP\DEOPEX\01 - Supervisão\10 - Alocação das equipes\Consulta Alocados\yaybook.xlsm"
ThisWorkbook.SaveAs path, FileFormat:=52
Set wbk = Workbooks.Open(path)
wbk.Sheets(1).Name = "FUNCIONARIOS"
End Sub
Everything works, so we might be missing details
Don't want to Hijack Doug's answer, so here's a way to test:
Try comment out the second part of your code - leave the "saveas" and
run. After finish go check your file in the destination path - see if
you can open it successfully by manual.
Now in a NEW sub open up this file by code. Do NOT set the sheet name yet. Let
us know the result
Edit:
Try saving the worksheet to a new workbook and save the new workbook:
Sub test()
Dim wbk As Workbook
Dim nwb As Workbook
Dim path As String
path = "C:\Users\dcoats\Desktop\CGP\DEOPEX\01 - Supervisão\10 - Alocação das equipes\Consulta Alocados\"
Set wbk = ThisWorkbook
Set nwb = Workbooks.Add
wbk.Sheets("Sheet1").Copy before:=nwb.Sheets(1)
nwb.SaveAs path & "test2.xlsx"
End Sub
Update "Sheet1" to whatever worksheetname you're saving
I'm trying to save one worksheet in my excel file to a new file, but without the formula's.
I have this code that is working to get the file saved:
Sub SaveInvoice()
'Create a filename based on invoicenumber
Dim FileName As String
FileName = Sheets("Sale").Range("C3").Value
'Copy the "Print" sheet
Worksheets("Print").Copy
With ActiveWorkbook
'Save the file as new
.SaveAs FileName:="C:\" & FileName
End With
End Sub
This works like a charm, however I need to strip out the formula's so I googled and fount this piece of code:
ActiveSheet.Copy
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
And this works as well, however once I merge the two pieces of code together the whole function breaks.
With ActiveWorkbook
'Transform cells to values
ActiveSheet.Copy
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Save the file as new
.SaveAs FileName:="C:\" & FileName
End With
This results in my base worksheet beeing stripped from formula's.
I need to know how I can call the function on the newle created workbook.
When copying a worksheet with no Destination excel creates a New Workbook, and the New Workbook with its only Worksheet are active.
EDIT: I just realized that in the final code these lines from the original code:
'Copy the "Print" sheet
Worksheets("Print").Copy
Were moved inside the
With ActiveWorkbook
That was previously referring to the New Workbook created by the Worksheet.Copy and that now refers to the Source Workbook
So let see what the Op's final code is actually doing:
Here the ActiveWorkbook is the [Source Workbook] and the ActiveSheet must be [Print]
With ActiveWorkbook
This copies the ActiveSheet creating a New Workbook with only one sheet
ActiveSheet.Copy
These lines are affecting the ActiveSheet [Print] in the [Source Workbook].
Not because of the With statement but because it's the one active
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
The commands within a With intended to affect object that it refers to must start with a dot [.]; however these lines are invalid because Cells and Range are not Methods nor Properties of the Workbook Object, thus en error would have been triggered.
With Statement
Executes a series of statements on a single object or a user-defined type.
(from the msdn.microsoft.com help)
This saves the Workbook referred by the With statement, which still has the formulas
'Save the file as new
.SaveAs FileName:="C:\" & FileName
End With
Try this code:
Sub SaveInvoice_TEST_1()
'Create a filename based on invoicenumber
Dim FileName As String
With ThisWorkbook
FileName = .Sheets("Sale").Range("C3").Value
'Copy the "Print" sheet
.Worksheets("Print").Copy
End With
With ActiveWorkbook
Rem Replace Formulas with Values
.Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value2
'Save the file as new
.SaveAs FileName:="C:\" & FileName
End With
End Sub
Suggest to read the following pages to gain a deeper understanding of the resources used:
With Statement
Try something like the following. Read the help page for 'ActiveSheet.Copy' - note that it creates a new workbook and activates it
Dim MyWkbk as workbook
set MyWkbk = ActiveWorkbook
ActiveSheet.Copy
With ActiveWorkbook
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Save the file as new
.SaveAs FileName:="C:\" & FileName
'.close
End With
MyWkBk.activate
Thanks to #EEM the solution was found.
Here's the code I used:
Sub SaveInvoice()
Dim FileName As String
With ThisWorkbook
'Create a filename based on invoicenumber
FileName = .Sheets("Sale").Range("C3").Value
'Copy the "Print" sheet
.Worksheets("Print").Copy
End With
With ActiveWorkbook
'Replace Formulas with Values
.Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value2
'Save the file as new
.SaveAs FileName:="C:\" & FileName
End With
End Sub
I have found the below code to save sheet as new workbook but what I wanted to know if it is possible to change the save name
each time the macro is run to the value on sheet 1 in cells B2 and to a specific file location.
I have tried the way below and it just simply saves the file with the name of the file location instead of saving it in the file location specified.
Sub sb_Copy_Save_Worksheet_As_Workbook()
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Sheet2").Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\temp\test1.xlsx"
End Sub
Any help would be greatly appreciated
many thanks
Jamie
Let's say "Sheet1" has in cell B2 the value "test1" (the filename), then you can use the following:
Sub sb_Copy_Save_Worksheet_As_Workbook()
Dim wb As Workbook
Dim myPath As String
Dim myFilename As String
Dim myFileExtension As String
myPath = "C:\temp\" 'you can change this
myFileExtension = ".xlsx"
myFilename = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Sheet2").Copy Before:=wb.Sheets(1)
wb.SaveAs myPath & myFilename & myFileExtension
wb.Close False
End Sub
If your cell B2 already includes the file extension (so it is "test1.xlsx" in B2), just remove the myFileExtension parts from the code.
The folder, where you want to save your file has to exist. If you need help checking this or creating the folder in your macro, please leave a comment.
Try adding on the cell value to the path string like this:
Sub sb_Copy_Save_Worksheet_As_Workbook()
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Sheet2").Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\temp\" & ThisWorkbook.Sheets("Sheet2").Range("B2").Value
End Sub
File extension will default to .xlsx even if the original file is .xlsm so you don't need to add this to the path string.