Newbie VBA code help

[Etv5002]

Hi I know pretty much nothing about VBA, I plan on learning by doing.

I currently need help with the first macro project I've been working on I feel the the bare essential is there but I would realy like be be able to present something stellar.

The Goal of the MACRO:

I would a Worksheet that 1 button on it to run this specific macro, and 2 cells that are used within the macro.

the Macro needs to start by allowing the user to select what excel file the macro needs to be executed on (this part I'm having trouble with).

and the execution need to take all of the worksheets in the file and save them as individual workbooks:

 Sub PLExport2invWkbkCode()
    Dim wsMain As Worksheet
    Dim wsNew As Worksheet
    Dim wsPrior As Worksheet
    Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
 
    Set OldBook = ThisWorkbook
 
    For Each sh In OldBook.Worksheets
        If sh.Visible = True Then
            sh.Copy
            ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & sh.Name & " part of the file name goes here ", FileFormat:=xlWorkbookNormal
            ActiveWorkbook.Close
        End If
    Next
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub

this part works well, but I would like the text of the file name to reference a cell then the sheet name then the second cell rather then type it into the code which is how it currently is.

end.

getting that accomplished would be Awesome

Also I would eventually like to have those NOW individual workbooks auto email themselves (each sheet to a different email address) based on the file name and a list of email addresses.


Any Help would be greatly appreciated,

Thankyou.

 

[jfish1288]

you should be able to change

 ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & sh.Name & " part of the file name goes here "

to

 ActiveWorkbook.SaveAs Filename:= your reference cell

Im not sure how to do the email thing

 

[Etv5002]

you should be able to change

[

 ActiveWorkbook.SaveAs Filename:= your reference cell

Hey Jfish thanks for responding, how would I go about referencing the cell in a different work book

 

[jfish1288]

ActiveWorkbook.SaveAs Filename:= Workbooks("your workbook name").Worksheets("your worksheet name").Range("your cell")

 

[Etv5002]

Sub Button3_Click()
Dim TargetFilename As String
    TargetFilename = Application.GetOpenFilename _
    Dim wsMain As Worksheet
    Dim wsNew As Worksheet
    Dim wsPrior As Worksheet
    Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
     
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
     
     
    Set OldBook = ThisWorkbook
     
    For Each sh In OldBook.Worksheets
        If sh.Visible = True Then
            sh.Copy
            ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & ThisWorkbook.Worksheets(Sheet1).Range(D5) & sh.Name & ThisWorkbook.Worksheets(Sheet1).Range(D7), FileFormat:=xlWorkbookNormal
            ActiveWorkbook.Close
        End If
    Next
     
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
     
End Sub

I keep running this and there is an error, any suggestions?

 

[jfish1288]

Ok you have a few issues. First any time you use parentheses and a name you have to put the name in qoutes. For example

ThisWorkbook.Worksheets("Sheet1").Range("D5")

Second typically I like to set the filename equal to only the string of text I want to name the file. I use chdrive and chdir to make sure that I am in the correct filepath. I think that this is redundant in your case as you never change directories.

Third you seem to be copying each sheet for no reason.

Lets try this code

Sub Button3_Click()
Dim TargetFilename As String
    TargetFilename = Application.GetOpenFilename _
    Dim wsMain As Worksheet
    Dim wsNew As Worksheet
    Dim wsPrior As Worksheet
    Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
 
    Set OldBook = ThisWorkbook
 
    For Each sh In OldBook.Worksheets
        If sh.Visible = True Then
        ChDrive OldBook.Path 
        ChDir OldBook.Path 
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Worksheets("Sheet1").Range("D5") & sh.Name & ThisWorkbook.Worksheets("Sheet1").Range("D7"), FileFormat:=xlWorkbookNormal
        ActiveWorkbook.Close
        End If
    Next
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub

 

[Etv5002]

Hey J,

This is the code im going with, that copying was reason for the macro. I needed it to pull sheets from a workbook and make them into individual workbooks.

My code thanks to your help accomplishes that now (thank you), but the last problem is that when I run it, it only proforms the macro on the macro sheet not the target sheet.

I need it to be able to allow you to select the sheet you want the macro to run on, but make the file name reference the 2 cells on the macro sheet. so it comes out like
filename= (cell 1 macrosheet) (targetsheets sheetname) then (cell 2 macro Sheet)

Let me know if there is a way I can upload my file it might be easier to see.

Sub Button3_Click()
Dim TargetFilename As String
    TargetFilename = Application.GetOpenFilename _
    Dim wsMain As Worksheet
    Dim wsNew As Worksheet
    Dim wsPrior As Worksheet
    Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
 
    Application.ScreenUpdating = False
 
 
    Set OldBook = ThisWorkbook
 
    For Each sh In OldBook.Worksheets
        If sh.Visible = True Then
            sh.Copy
            ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & ThisWorkbook.Worksheets("Sheet1").Range("D6") & sh.Name & ThisWorkbook.Worksheets("Sheet1").Range("D7"), FileFormat:=xlWorkbookNormal
            ActiveWorkbook.Close
        End If
    Next
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub

 

[jfish1288]

Perhaps we should sart from the beginning with what you have and what your end goal is.

My understanding is that you have a workbook with multiple sheets.

You want to asign a button to a macro that will take each sheet and save it as its own workbook. You want the new workbook consisting of one sheet to be saved with the file name "Cell D6 from sheet 1, sheet name, cell D7 from sheet 1" without commas, in the same location as the original workbook was saved. Is this correct?

 

[Etv5002]

YES, absolutley correct. EXCEPT!!!

I have a Macro sheet, the only thing it has on it is this macro button nothing else. That button needs to run the Macro wel have defined up there on a separate workbook (one that I am able to choose).

so 2 workbooks:
1. the one with the macro in it from now on called "MacroWrkbk"
2 a separate workbook with mutiple sheets that need to be separated into individual workbooks aka "TargetWrkbk"

the file name needs to be a combination of both workbooks
consisting of cells d6 & d7 of MacrWrkbk, and the sheets name in TargetWrkbk

 

[jfish1288]

Ok I added a input cell in your macro workbook

in cell D5 you will want to type the name of your target workbook

try this out

Sub savesheets()
Dim sh As Worksheet
Dim TargetWrkbk As Workbook
Dim TargetWrkbkName As String
Dim First As String
Dim Last As String
TargetWrkbkName = Range("D5")
First = Range("D6")
Last = Range("D7")
Set TargetWrkbk = Workbooks(TargetWrkbkName)
Application.ScreenUpdating = False
With TargetWrkbk
For i = 1 To .Worksheets.Count
    Set sh = .Worksheets(i)
    sh.Copy
    ActiveWorkbook.SaveAs Filename:=First & sh.Name & Last
    ActiveWorkbook.Close
Next
End With
Application.ScreenUpdating = True
End Sub