Macro to copy certain sheets to a new workbook, then save the workbook, naming it the worksheet name

[diygail123]

Hi guys

I am trying to write a macro that will copy a worksheet, then save it using the worksheet name as the filename. I then want it to go to other worksheets, in the same workbook, and do the same. I was trying to use a list of names typed on a worksheet (List of Names) to tell the macro which worksheets to copy, but Im not having much luck! I need the macro to scroll through said worksheets, creating a copy, and saving, using the worksheet name as a filename. See below for as far as I have got. Dont laugh, Im a beginner! The save isnt working, its naming it as the sheet I started on (called Macro), and I dont know how to get it to loop through the names on the list

Sub CopySave2()


'DECLARE VARIABLES
Dim StrFileName As String
StrFileName = ActiveSheet.Name & ".xlsx"


Dim ListOfNames As Range, c As Range
Set ListOfNames = Worksheets("List of Names").Range("b2:b20") 'BRIAN KRAL IS THE FIRST WORKSHEET I WANT TO COPY BUT I DONT KNOW HOW TO PUT THIS IN THE CODE WITHOUT STATING THE NAME!


'For Each c??


'MAKE A COPY OF FIRST WORKSHEET ON THE LIST, TO A NEW WORKBOOK
Sheets("BRIAN KRAL").Copy
'ADD TWO WORKSHEETS AND NAME THEM "DETAILS" & "PIVOT"
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Name = "Details"
Sheets("Sheet2").Name = "Pivot"

'SAVE THE WORKBOOK
ActiveWorkbook.SaveAs StrFileName

Next c

 

[Kamolga]

Dim Sh As Worksheet
For Each c In ListOfNames
    For Each Sh In Worksheets
        If Sh.Name = c.Value Then
             Sh.copy
             Sheets.Add After:=ActiveSheet
             ActiveSheet.Name = "Details"
             Sheets.Add After:=ActiveSheet
             ActiveSheet.Name = "Pivot"
        End If
    Next Sh
Next c

 

[ranman256]

Sub CopySave2()
'DECLARE VARIABLES
Dim colShts As New Collection
Dim StrFileName As String, sName As String
Dim ListOfNames As Range, c As Range
Dim i As Integer


'Set ListOfNames = Worksheets("List of Names").Range("b2:b20") 'BRIAN KRAL IS THE FIRST WORKSHEET I WANT TO COPY BUT I DONT KNOW HOW TO PUT THIS IN THE CODE WITHOUT STATING THE NAME!


   'collect only items not null
Sheets("List of Names").Activate
Range("b2").Select
While ActiveCell.Value <> ""
  colShts.Add ActiveCell.Value
  ActiveCell.Offset(1, 0).Select 'next row
Wend


For i = 1 To colShts.Count
     sName = colShts(i)
     
          'MAKE A COPY OF FIRST WORKSHEET ON THE LIST, TO A NEW WORKBOOK
    Sheets(sName).Select
    StrFileName = ActiveSheet.Name & ".xlsx"


    Sheets(sName).Copy
    ActiveWorkbook.SaveAs Filename:=StrFileName, FileFormat:=xlOpenXMLWorkbook
    ActiveWindow.Close
Next
Set colShts = Nothing
End Sub

 

[Fluff]

Another option

Sub CopySave2()
   Dim Cl As Range

   For Each Cl In Sheets("List of Names").Range("b2:b20")
      Sheets(Cl.Value).Copy
      With ActiveWorkbook
         .Sheets.Add.Name = "Details"
         .Sheets.Add.Name = "Pivot"
         .SaveAs ThisWorkbook.Path & "\" & Cl.Value & ".xlsx", 51
         .Close False
      End With
   Next Cl
End Sub

 

[diygail123]

Many thanks guys, these all work great.

 

[Fluff]

Glad we could help & thanks for the feedback