Save As in a Macro

[Derek Johansen]

I have a spreadsheet with a lot of information. I then separate them into
separate workbooks to make it easier to manage. I generally create three new
workbooks from the data. what I would like to do is Save As each of these
new work books IN THE SAME DIRECTORY as the original and with the file name
ORIGINALNAME_wb1, ORIGINALNAME_wb2 etc.

The important part is that the files are in the same directory, and contain
the original name in them... does anyone have a bit of code i could use to do
this? I've played around with the save as, but I can't figure out how to get
the same directory as the original and add on to the name... any help would
be much appreciated!

Thanks,

Derek

 

[r]

or

Sub test_1()
Dim i As Long
Dim s As String
For i = 1 To 3
s = NewName(ThisWorkbook, "_wb" & i)
Debug.Print s
Next
End Sub

Function NewName(wb As Workbook, sNew As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = RE.Replace(wb.FullName, sNew & "$&")
End Function

regards
r

--
Come e dove incollare il codice:
http://www.rondebruin.nl/code.htm

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html

Sub test_1()
Dim i As Long
Dim s As String
For i = 1 To 3
s = NewName(i)
MsgBox s
Next
End Sub

Function NewName(i As Long) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = ThisWorkbook.Path & _
Application.PathSeparator & _
RE.Replace(ThisWorkbook.Name, "_vb" & i & "$&")
End Function

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html

I'm not sure I am able to follow this enough to know where my inputs would
be. What would I need to change to customize the name of each book?

Function NewName(i As Long) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = ThisWorkbook.Path & _
Application.PathSeparator & _
RE.Replace(ThisWorkbook.Name, "_vb" & i & "$&")
End Function

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html


:

I have a spreadsheet with a lot of information. I then separate them into
separate workbooks to make it easier to manage. I generally create three new
workbooks from the data. what I would like to do is Save As each of these
new work books IN THE SAME DIRECTORY as the original and with the file name
ORIGINALNAME_wb1, ORIGINALNAME_wb2 etc.

The important part is that the files are in the same directory, and contain
the original name in them... does anyone have a bit of code i could use to do
this? I've played around with the save as, but I can't figure out how to get
the same directory as the original and add on to the name... any help would
be much appreciated!

Thanks,

Derek

 

[Derek Johansen]

r,

I'm really struggling to understand your code, keep in mind I'm very new to
VB. I get a ByRef error every time I try to run your code at line "s = ..."
Please maybe explain what is supposed to be happening or something?

or

Sub test_1()
Dim i As Long
Dim s As String
For i = 1 To 3
s = NewName(ThisWorkbook, "_wb" & i)
Debug.Print s
Next
End Sub

Function NewName(wb As Workbook, sNew As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = RE.Replace(wb.FullName, sNew & "$&")
End Function

regards
r

--
Come e dove incollare il codice:
http://www.rondebruin.nl/code.htm

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html

Sub test_1()
Dim i As Long
Dim s As String
For i = 1 To 3
s = NewName(i)
MsgBox s
Next
End Sub

Function NewName(i As Long) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = ThisWorkbook.Path & _
Application.PathSeparator & _
RE.Replace(ThisWorkbook.Name, "_vb" & i & "$&")
End Function

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html

I'm not sure I am able to follow this enough to know where my inputs would
be. What would I need to change to customize the name of each book?

:

Function NewName(i As Long) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = ThisWorkbook.Path & _
Application.PathSeparator & _
RE.Replace(ThisWorkbook.Name, "_vb" & i & "$&")
End Function

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html


:

I have a spreadsheet with a lot of information. I then separate them into
separate workbooks to make it easier to manage. I generally create three new
workbooks from the data. what I would like to do is Save As each of these
new work books IN THE SAME DIRECTORY as the original and with the file name
ORIGINALNAME_wb1, ORIGINALNAME_wb2 etc.

The important part is that the files are in the same directory, and contain
the original name in them... does anyone have a bit of code i could use to do
this? I've played around with the save as, but I can't figure out how to get
the same directory as the original and add on to the name... any help would
be much appreciated!

Thanks,

Derek

 

[Don Guillett]

Maybe you mean to save sheets as separate workbooks.??

Sub saveshtsasworkbooks()
myarray = Array("sheet2", "sheet7")
shtnum = 2
For Each sht In myarray
newname = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
Sheets(sht).Copy
ActiveWorkbook.SaveAs Filename:=newname & "_Wb" & shtnum
ActiveWindow.Close
shtnum = shtnum + 1
Next sht
End Sub

 

[Derek Johansen]

I've modified this slightly to meet my needs, but the only thing is that the
macro is adding the letter "m" after the original file name... I can't figure
out to save my life why it is adding an m. Any ideas?

 

[Jacob Skaria]

Check the file extension of the original file...I assumed it is .xls...If not
try the below

strFile = Replace(ActiveWorkbook.Name, ".xlsm", "", 1, 1, vbTextCompare)

 

[r]

This occurs if in the module does not have NewName function
have you paste all code in a module?
regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html

r,

I'm really struggling to understand your code, keep in mind I'm very new to
VB. I get a ByRef error every time I try to run your code at line "s = ..."
Please maybe explain what is supposed to be happening or something?

or

Sub test_1()
Dim i As Long
Dim s As String
For i = 1 To 3
s = NewName(ThisWorkbook, "_wb" & i)
Debug.Print s
Next
End Sub

Function NewName(wb As Workbook, sNew As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = RE.Replace(wb.FullName, sNew & "$&")
End Function

regards
r

--
Come e dove incollare il codice:
http://www.rondebruin.nl/code.htm

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html

Sub test_1()
Dim i As Long
Dim s As String
For i = 1 To 3
s = NewName(i)
MsgBox s
Next
End Sub

Function NewName(i As Long) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = ThisWorkbook.Path & _
Application.PathSeparator & _
RE.Replace(ThisWorkbook.Name, "_vb" & i & "$&")
End Function

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html


:

I'm not sure I am able to follow this enough to know where my inputs would
be. What would I need to change to customize the name of each book?

:

Function NewName(i As Long) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = ThisWorkbook.Path & _
Application.PathSeparator & _
RE.Replace(ThisWorkbook.Name, "_vb" & i & "$&")
End Function

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html


:

I have a spreadsheet with a lot of information. I then separate them into
separate workbooks to make it easier to manage. I generally create three new
workbooks from the data. what I would like to do is Save As each of these
new work books IN THE SAME DIRECTORY as the original and with the file name
ORIGINALNAME_wb1, ORIGINALNAME_wb2 etc.

The important part is that the files are in the same directory, and contain
the original name in them... does anyone have a bit of code i could use to do
this? I've played around with the save as, but I can't figure out how to get
the same directory as the original and add on to the name... any help would
be much appreciated!

Thanks,

Derek

 

[eliano]

r,

I'm really struggling to understand your code, keep in mind I'm very new to
VB.  I get a ByRef error every time I try to run your code at line "s = ..."  
Please maybe explain what is supposed to be happening or something?

Hi Derek.
The solution proposed by mister "r" is a macro wich use an UDF based
on Regular expression;
the result is visible in the Immediate window.

Please, copy the following macro (modified) & the original Udf in a
standard Module like Module1 and try,
executing the macro "test_1" :

'<----------------------------------------------
Public Sub test_1()
Dim i As Long
Dim s As String
Dim newbook As Workbook
For i = 1 To 3
Set newbook = Workbooks.Add
s = NewName(ThisWorkbook, "_wb" & i)
newbook.SaveAs Filename:=s
ActiveWindow.Close
Next
End Sub

Function NewName(wb As Workbook, sNew As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "\.[A-z]+$"
NewName = RE.Replace(wb.FullName, sNew & "$&")
End Function
'----------------------------------------->

The macro close the 3 workbooks after creation.
Sorry for my poor english and regards,
Eliano