VBA CODE : Loop through list

[Monty]

Hello Everybody.
Please excuse me posting question from mobile.

There are two columns to loop through.

Col A : Consists of workbook names list....2 Wb names.
Col B : Consists of worksheet names list....5 sht names.

Question:
We have master work book with two sheets Summary and List sheets...So in every work book must have these two sheets.

Loop through col A get the workbook name and create all sheets names from col B in the same workbook and save.

Example

Col A

Monty
Ronnie

Col B
A
B
C
D
E

So as per the example two workbooks to be created with 7 sheets.

In my real situation I have 386 Wb name in Col A and 230 sheets in Col B in the list sheet.

Hopefully not confused you guys with question.

Monty!

 

[Hui]

Assuming the list of Workbooks and Worksheets starts in Row 2
Try the following

Sub MakeFiles()

Dim WB As Workbook
Dim lwb As Integer, lws As Integer

lwb = Range("A" & Rows.Count).End(xlUp).Row
lws = Range("B" & Rows.Count).End(xlUp).Row - 1

For wbRow = 2 To lwb 'Starts in Row 2
  Call CreateWBwithSheets(Cells(wbRow, 1).Text, lws)
Next wbRow




End Sub

Sub CreateWBwithSheets(ByVal WBName As String, ByVal NumberOfSheetsNeeded As Integer)
' This Sub will create a new workbook and ensure the proper # of sheets
' are created in the Workbook.
' The "NumberOfSheetsNeeded" argument is the Number of Sheets
' Needed in the workbook
' For Example: I want the new workbook to have 5 sheets in it
' pass 5 to the "NumberOfSheetsNeeded" argument.

Dim x As Integer
Dim WB As Workbook
Dim WS As Worksheet
Dim CurrentSheetCount As Integer
Dim WSNames As Variant

'Get WSheet names
WSNames = Range("B2:B" & NumberOfSheetsNeeded + 1).Value

' create new wb
Set WB = Workbooks.Add

' get count of sheets in new workbook
' (can be different from user to user)
CurrentSheetCount = WB.Sheets.Count

' decide how many sheets there
If NumberOfSheetsNeeded = CurrentSheetCount Then
' if no sheets are needed just exit
' Do nothing
ElseIf NumberOfSheetsNeeded < CurrentSheetCount Then
' Delete extra sheets (always delete in reverse 3, 2, 1)
  For x = (CurrentSheetCount - NumberOfSheetsNeeded) To NumberOfSheetsNeeded Step -1

  If WB.Sheets.Count = 1 Then Exit For
  ' turn off alerts
  Application.DisplayAlerts = False
  ' delete sheet
  WB.Sheets(x).Delete
  Next x
ElseIf NumberOfSheetsNeeded > CurrentSheetCount Then
' create loop from (how many sheets there are) to (how many are needed)
  For x = (CurrentSheetCount) To NumberOfSheetsNeeded
  ' make sure we don't make any extra sheets
  If WB.Sheets.Count >= NumberOfSheetsNeeded Then Exit For
  ' then add sheets
  WB.Sheets.Add after:=WB.Sheets(WB.Sheets.Count)
  Next x
End If

For x = 1 To Worksheets.Count
  Worksheets(x).Name = WSNames(x, 1)

Next x

WB.SaveAs WBName & ".xlsx"
WB.Close False

Set WB = Nothing

' Workbook
End Sub

or see attached file:

However: Do you really want to make 386 empty workbooks with 230 empty worksheets?

.

 

[PCosta87]

Hi,

Perhaps something like this:

Sub AddWorkbooks()

Application.ScreenUpdating = False

    Dim wb, sh As Range
   
    For Each wb In ThisWorkbook.Sheets(1).Range("A1:A" & ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
        Workbooks.Add
        ActiveWorkbook.SaveAs "C:\Users\User\Desktop\" & wb
        For Each sh In ThisWorkbook.Sheets(1).Range("B1:B" & ThisWorkbook.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row)
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = sh
        Next sh
        Application.DisplayAlerts = False
        Sheets(1).Delete
        Application.DisplayAlerts = True
        ActiveWorkbook.Close True
    Next wb
   
Application.ScreenUpdating = True

End Sub

You may need to change the path in the SaveAs to where you would like the workbooks to be added.

See attached

Hope this helps

 

[Monty]

Thanks Guys....Really Helps.