通过循环创建具有多个工作表的工作簿

Question

I'm looping through a Scripting Dictionary and call a function that loads specific filtered and sorted datasets to a sheet named "DonneesFiltrees".

I want to create a single workbook and through this loop add Sheets to the new workbook and copy paste "DonneesFiltrees" dataset into each sheets.

There is my code at this moment, my loop and function are working great but I have no clue about how to insert multiple sheet to a new workbook

Set wsData = Worksheets("DonneesFiltrees")
Application.ScreenUpdating = False
    
Dim varkey As Variant
    
'ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\data_output\export_du_" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".xlsx")
    
For Each varkey In DicTheme.Keys

    Call ChargerLesDonnees(CStr(DicTheme(varkey)), Me.listEntreprise.Value)
        
    If wsData.Range("A2").Value <> "" Then
        
        'Create sheet into new Workbook,
        'Set DicTheme(varkey) as sheet name,
        'copy paste wsData sheet dataset into this new sheet.
            
    End If
        
Next varkey
    
Application.ScreenUpdating = True

Thank you in advance for your help.

Answer 1

Please have a look at the modified code of yours

Set wsData = Worksheets("DonneesFiltrees")
Application.ScreenUpdating = False
    
Dim varkey As Variant
    
'ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\data_output\export_du_" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".xlsx")
    
' Create a new workbook
Dim wkb As Workbook
Set wkb = Workbooks.Add
    
For Each varkey In DicTheme.Keys

    Call ChargerLesDonnees(CStr(DicTheme(varkey)), Me.listEntreprise.Value)
        
    If wsData.Range("A2").Value <> "" Then
        
        'Create sheet into new Workbook,
        Dim wks As Worksheet        ' no harm if one puts the declartion in the loop
        Set wks = wkb.Worksheets.Add
        
        'Set DicTheme(varkey) as sheet name,
        wks.Name = DicTheme(varkey)  ' DicTheme(varkey) should be a valid sheet name
        
        'copy paste wsData sheet dataset into this new sheet.
            
            
    End If
        
Next varkey
    
Application.ScreenUpdating = True

Further reading
Workbooks Add
Worsheets Add

Answer 2

Thanks a lot for bringing help, here is the final code in case it can interest people. As the workbook is created with a default worksheet I'm deleting it at the end before to set a name and save the file.

    Set wsData = Worksheets("DonneesFiltrees")
    Application.ScreenUpdating = False
    
    Dim varkey As Variant
              
    ' Create a new workbook
    Dim wkb As Workbook
    Set wkb = Workbooks.Add
        
    ThisWorkbook.Activate
    
    For Each varkey In DicTheme.Keys
    
        Call ChargerLesDonnees(CStr(DicTheme(varkey)), Me.listEntreprise.Value)
            
        If wsData.Range("A2").Value <> "" Then
            
            'Create sheet into new Workbook,
            Dim wks As Worksheet        ' no harm if one puts the declartion in the loop
            Set wks = wkb.Worksheets.Add
            
            'Set DicTheme(varkey) as sheet name,
            wks.Name = DicTheme(varkey)  ' DicTheme(varkey) should be a valid sheet name
            
            'copy paste wsData sheet dataset into this new sheet.
            wsData.Visible = xlSheetVisible
            wsData.ListObjects(1).HeaderRowRange.Copy Destination:=wks.Range("A1")
            wsData.ListObjects(1).DataBodyRange.Copy Destination:=wks.Range("A2")
            wsData.Visible = xlSheetHidden
                
        End If
            
    Next varkey
        
    Application.DisplayAlerts = False
    wkb.Sheets("Feuil1").Delete
    Application.DisplayAlerts = True
    wkb.SaveAs (ThisWorkbook.Path & "\data_output\export_GLOBAL_de_" & Me.listEntreprise.Value & "_du_" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".xlsx")
    wkb.Close
 
    ThisWorkbook.Activate
    
    wsData.Cells.Clear
    
    Application.ScreenUpdating = True