need Macro to export 4 worksheets to a new workbook and to save the new workbook as a name from a single cell plus additional standard information in

[wiggins2402]

Hi,
I am looking for a macro that will export four names sheets to a new workbook then save to a specific file location on out network. the file name needs to contain the name in a specific cell "F2"on one of the work sheet tabs "2016 Distributor Medalist Results". The new file name should be "2016 F2 (Name in cell F2) Medalist Results & Planning Forms". The name in cell "F2" will be the distributor name. Each file will be saved in a specific folder on the network with the file path N:\Medalist Program\FY2016\.

I am new to VBA coding and this will help greatly in expediting results for our Medalist program.

Thanks,

 

[Nine Zero]

Hi,
I am looking for a macro that will export four names sheets to a new workbook then save to a specific file location on out network. the file name needs to contain the name in a specific cell "F2"on one of the work sheet tabs "2016 Distributor Medalist Results". The new file name should be "2016 F2 (Name in cell F2) Medalist Results & Planning Forms". The name in cell "F2" will be the distributor name. Each file will be saved in a specific folder on the network with the file path N:\Medalist Program\FY2016\.

I am new to VBA coding and this will help greatly in expediting results for our Medalist program.

Thanks,

Hey try this out....

Sub SaveAsTest()




 Dim NameFile As Variant
        With Worksheets("[COLOR=#333333]2016 Distributor Medalist Results[/COLOR]")
        NameFile = "2016 " & .Range("F2") & " [COLOR=#333333]Medalist Results & Planning Forms" & [/COLOR]".xls"
        End With
        Sheets("[COLOR=#333333]2016 Distributor Medalist Results[/COLOR]").Select
        Sheets("[COLOR=#333333]2016 Distributor Medalist Results[/COLOR]").Copy
        NameFile = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Desktop\" & NameFile, Filefilter:="(*.xls), *.xls")
        If NameFile = False Then
        MsgBox "File not saved"
        Else
        ActiveWorkbook.SaveAs Filename:=NameFile
        End If




End Sub

I use this code personally on a daily basis .... let me know how it goes for you

 

[wiggins2402]

Nine Zero,
Thanks for the reply but this only solves half of the issue. I need the whole code to execute the action. Can you please recommend the rest of the code to copy the 4 worksheets from the master workbook (worksheets are: 2016 Medalist Results Form, 2017 Medalist Planning Form, Distributor Form, and ISIC Codes) into a new workbook (without copying the macros into the new workbook)? The destination for the new file to be saved on the network drive will be N:\Medalist Program\FY2016\. Thanks so much for your help with this issue.

 

[wiggins2402]

OK I would like to be more specific about what it is I am trying to accomplish. I have a workbook that has 8 tabs. I need a VBA code that will export 4 named tabs (2016 Medalist Results Form, 2017 Medalist Planning Form, Distributor Form, and ISIC Codes) remove the macros and delete all links to the new workbook but maintain formulas within the named sheets and saved to a specific network drive location N:\Medalist Program\FY2016\. The new workbook will need to be saved with the file name being "2016 + (Name from cell F2 of "2016 Medalist Results Form") +"Medalist Results & Planning Forms".

Thanks for your assistance.
Regards,

 

[wiggins2402]

Alright I tried watching many youtube videos and reading web blogs about vba and I think what I am trying to accomplish is a do until is empty loop. I know I may have butchered the coding and am in dire need of some expert advice. Attached is the code I came up with but am getting a compile error: Sub or Function not defined. Can someone please help the needy?

Sub Medalist_Results_Test()


 Dim NameFile As Variant
        With Worksheet("2016 Medalist Results Form")
        NameFile = "2016 Medalist Results & 2017 Planning - " & Range("F2") & ".xlsx"
        End With
        
    Worksheet("2016RR Accrual Template").Select
    Range("A8").Select
    ActiveCell.Range("A1").Copy
        
  Do Until IsEmpty(ActiveCell)
    ActiveCell.Range("A1").Copy
    wst("2016 Medalist Results Form").Range("E1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    If Dir("N:\Medalist Program\FY2016\" & NameFile & ".xlsx") = vbNullString Then
         
        wst(Array("2016 Medalist Results Form", "2017 Medalist Planning Form", "2017 Medalist Targets Form", "2017 Medalist Existing Form")).Copy
         
        For Each Worksheet In Worksheets
            With Cells
                .Copy
                .PasteSpecial xlPasteValues
            End With
            Range("A1").Select
        Next Worksheet
         
        ActiveWorkbook.SaveAs Filename:="N:\Medalist Program\FY2016\" & NameFile & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, _
        CreateBackup:=False
         
         
    Else
     Exit Sub
         
    Application.CutCopyMode = False


    End If
        
    Loop


End Sub

 

[wiggins2402]

With the help of one of our companies IT Guys we were able to fix many of the mistakes i made and now the code works perfectly. Below is the final VBA code.

Sub ExportForms() Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("2016RR Accrual Template").Activate
Range("A8").Select
Do Until IsEmpty(ActiveCell)
Set myActiveCell = ActiveCell
BillTo = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
strName = Replace(Replace(Replace(Trim(ActiveCell.Value), "\", "-"), "/", "-"), "*", "")
ActiveCell.Offset(0, 1).Select
region = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
territory = ActiveCell.Value

Sheets("2016 Medalist Results Form").Range("E1").Value = BillTo
Worksheets("2016 Medalist Results Form").Activate
Range("F2").Select
strFileName = "N:\Medalist Program\FY2016\" & _
"2016 Medalist Results & 2017 Planning - (" & _
region & ")(" & territory & ")(" & _
BillTo & ") " & _
strName & ".xlsx"
Sheets(Array("2016 Medalist Results Form", _
"2017 Medalist Planning Form", _
"2017 Medalist Targets Form", _
"2017 Medalist Existing Form")).Copy
ActiveWorkbook.SaveAs strFileName
ActiveWorkbook.Close
Workbooks("2016 Distributor Planning Form -Master-revH.xlsm").Activate
Worksheets("2016RR Accrual Template").Activate
myActiveCell.Activate
ActiveCell.Offset(1, 0).Select
Loop
End Sub

 

[wiggins2402]

Sorry but here it is again in the code box

Sub ExportForms() Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("2016RR Accrual Template").Activate
Range("A8").Select
Do Until IsEmpty(ActiveCell)
Set myActiveCell = ActiveCell
BillTo = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
strName = Replace(Replace(Replace(Trim(ActiveCell.Value), "\", "-"), "/", "-"), "*", "")
ActiveCell.Offset(0, 1).Select
region = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
territory = ActiveCell.Value

Sheets("2016 Medalist Results Form").Range("E1").Value = BillTo
Worksheets("2016 Medalist Results Form").Activate
Range("F2").Select
strFileName = "N:\Medalist Program\FY2016\" & _
"2016 Medalist Results & 2017 Planning - (" & _
region & ")(" & territory & ")(" & _
BillTo & ") " & _
strName & ".xlsx"
Sheets(Array("2016 Medalist Results Form", _
"2017 Medalist Planning Form", _
"2017 Medalist Targets Form", _
"2017 Medalist Existing Form")).Copy
ActiveWorkbook.SaveAs strFileName
ActiveWorkbook.Close
Workbooks("2016 Distributor Planning Form -Master-revH.xlsm").Activate
Worksheets("2016RR Accrual Template").Activate
myActiveCell.Activate
ActiveCell.Offset(1, 0).Select
Loop
End Sub