Save a copy from cell data and close orignal

[Dando265]

Hi,

Can anyone please help, i've searched for a solution but can't find
the right one.

I want to save an excel workbook to the value of 2 cells P29 and Q29
The data in the cells is first name and surname.

i need a macro that will do the following.

Create a new folder from the contents of P29 & Q29

save a copy of the workbook to the new folder named in P29 & Q29 with
the same name

Then close the orignal without any changes

Eg file opened = d:\my documents\client files\productorder.xls
P29 = John
Q29 = Smith
Once the order is filled in the macro is run and a new folder is
created d:\my documents\client files\John Smith (If the folder
already exists the to append the folder name with _1 or _2 etc etc)
and a new file is made in the new folder
d:\my documents\clientfiles\John Smith\John Smith.xls

Then the original file discards the changes and closes ready to use
again another day.

Anyone got any ideas, I havn't got a clue what i'm doing really,
please help

Many thanks in advance.

 

[Bernie Deitrick]

This will create a new folder with incremented indexing:

Sub TryNow2()
Dim i As Integer
For i = 1 To 100
If Dir(ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & "_" & i & "\" & _
Range("P29").Value & " " & Range("Q29").Value & ".xls" ) = "" Then GoTo FolderNotFound
Next i
FolderNotFound:
MkDir ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & "_" & i
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & "_" & i & "\" & _
Range("P29").Value & " " & Range("Q29").Value & ".xls"

End Sub


HTH,
Bernie
MS Excel MVP

 

[Bernie Deitrick]

Oops, forgot to add code to close the original without saving changes:

Thisworkbook.Close False

HTH,
Bernie
MS Excel MVP

 

[Dando265]

Oops, forgot to add code to close the original without saving changes:

Thisworkbook.Close False

HTH,
Bernie
MS Excel MVP









- Show quoted text -

Hey Bernie, what a genius, fantasic.

Can you look at it again and see if I can have the the first saved
copy without the _1 and only if the folder exists then add the
increment?

Or what would make it perfect for me would be if I could use another
Cell say A1 that already has the auto increment there as an order
number. Then we can place the order number at the begining of the
folder name and the file name.

E.G.
A1 = 7224, P29= John, Q20=Smith
folder = 7224 John Smith,
file = 7224 John Smith.xls

That way It will make indexing and searching the files much easier and
quicker.
Many thanks, your help is much apriciated.

Regards

Dan

 

[Bernie Deitrick]

First one:


Sub TryNow2()
Dim i As Integer
For i = 0 To 100
If Dir(ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & IIF(i=0,"", "_" &
i) & "\" & _
Range("P29").Value & " " & Range("Q29").Value & ".xls" ) = "" Then GoTo
FolderNotFound
Next i
FolderNotFound:
MkDir ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & IIF(i=0,"", "_" &
i)
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & IIF(i=0,"", "_" &
i) & "\" & _
Range("P29").Value & " " & Range("Q29").Value & ".xls"

End Sub



Second one:

Sub TryNow2()

MkDir ThisWorkbook.Path & _
"\" & Range("A1").Value & " " & Range("P29").Value & _
" " & Range("Q29").Value
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & _
"\" & Range("A1").Value & " " & Range("P29").Value & _
" " & Range("Q29").Value & "\" & Range("A1").Value & " " & _
Range("P29").Value & " " & Range("Q29").Value & ".xls"

End Sub


HTH,
Bernie
MS Excel MVP

 

[Dando265]

First one:

Sub TryNow2()
Dim i As Integer
For i = 0 To 100
If Dir(ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & IIF(i=0,"", "_" &
i) & "\" & _
Range("P29").Value & " " & Range("Q29").Value & ".xls" ) = "" Then GoTo
FolderNotFound
Next i
FolderNotFound:
MkDir ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & IIF(i=0,"", "_" &
i)
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & _
"\" & Range("P29").Value & " " & Range("Q29").Value & IIF(i=0,"", "_" &
i) & "\" & _
Range("P29").Value & " " & Range("Q29").Value & ".xls"

End Sub

Second one:

Sub TryNow2()

MkDir ThisWorkbook.Path & _
"\" & Range("A1").Value & " " & Range("P29").Value & _
" " & Range("Q29").Value
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & _
"\" & Range("A1").Value & " " & Range("P29").Value & _
" " & Range("Q29").Value & "\" & Range("A1").Value & " " & _
Range("P29").Value & " " & Range("Q29").Value & ".xls"

End Sub

HTH,
Bernie
MS Excel MVP











- Show quoted text -

Many Thanks Bernie,

I used number 2 Cheers

Dan