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.
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)
As pre-warning, I am new to using VBA.
I have scraped together the following code to do the following:
1. Locate the worksheet "Intrastat"
2. Copy the used range of this worksheet
3. Paste as values into a new workbook
4. Reformat dates in column B
5. Save the workbook with in the original workbook's location.
However this only works when I have the macro saved in the original workbook. What I need is to be able to have the macro saved in a different workbook and on running the macro I need to be able to select the "original" workbook from a file location on my HDD.
Any ideas?
The Current Code:
Sub TB_Intrastat_Data_Cleanse()
Dim wb As Workbook
Set wb = Workbooks.Add
Set TWKB = ThisWorkbook
Set sel = Selection
Dim folderPath As String
folderPath = Application.ThisWorkbook.Path
TWKB.Sheets("Intrastat").UsedRange.Copy
wb.Sheets(1).[a1].PasteSpecial xlPasteValues
Columns("B:B").Select
Selection.NumberFormat = "dd/mm/yyyy;#"
nme = "TB Intrastat Data " & Range("A3") & " MTD"
ActiveWorkbook.SaveAs Filename:=folderPath & nme
End Sub
You can use Application.GetOpenFilename() to prompt the user to browse through the file explorer, and open a file. It will then use that file as TWKB:
Sub TB_Intrastat_Data_Cleanse()
Dim wb As Workbook, TWKB As Workbook
Dim sel As Range
Dim nme As String
Set wb = Workbooks.Add
Set TWKB = Application.GetOpenFilename(Title:="Please choose a file to open", FileFilter:="Excel Files *.xls* (*.xls*),")
Set sel = Selection
Dim folderPath As String
folderPath = Application.ThisWorkbook.Path
TWKB.Sheets("Intrastat").UsedRange.Copy
wb.Sheets(1).[a1].PasteSpecial xlPasteValues
Columns("B:B").NumberFormat = "dd/mm/yyyy;#"
nme = "TB Intrastat Data " & Range("A3") & " MTD"
ActiveWorkbook.SaveAs Filename:=folderPath & nme
End Sub
Note: I would change ActiveWorkbook.SaveAs at the end to a workbook variable (or explicitly name the workbook), since you're using two separate ones you want to make sure it's saving the correct one.
Basically I would like to import data by clicking on a button assigned with the macro which would open the file browser, prompting the user to open the excel file they would like to import. I have tried to debug my codes but my For Each loop keeps getting an error, any help is appreciated!
Sub BrowseForFile()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
fileName = Application.GetOpenFilename(, , "Browse for Workbook")
Workbooks.Open (fileName)
For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("FIEP.xlsm").Worksheets.count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("FIEP.xlsm").Worksheets(total)
Next sheet
Workbooks(fileName).Close
End Sub
Use a variable for the workbook object:
Sub BrowseForFile()
Dim directory As String, fileName As String, sheet As Worksheet, total As Long
Dim wb As Workbook
fileName = Application.GetOpenFilename(, , "Browse for Workbook")
Set wb = Workbooks.Open(fileName)
For Each sheet In wb.Worksheets
total = Workbooks("FIEP.xlsm").Worksheets.count
sheet.Copy after:=Workbooks("FIEP.xlsm").Worksheets(total)
Next sheet
wb.Close
End Sub
Remove the file path part. Variety of methods available. I used the one from here.
The Workbooks object is the collection of all the Workbook
objects that are currently open in the Microsoft Excel application.
It does not need the file path just the name. You could also have said ActiveWorkbook, though this would have been perhaps less robust.
Edit: Or as in #TimWilliam's answer, you can store the now open workbook in a variable and use that as the reference.
Option Explicit
Sub BrowseForFile()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
fileName = Application.GetOpenFilename(, , "Browse for Workbook")
Workbooks.Open (fileName)
Dim fso As New FileSystemObject 'Requires references to MS Scripting Runtime
fileName = fso.GetFileName(fileName)
For Each sheet In Workbooks(fileName).Worksheets '
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("FIEP.xlsm").Worksheets(total)
Next sheet
Workbooks(fileName).Close
End Sub
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 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