How can Igenerate a workbook consisting of over 1000 worksheets, each derived from the data in a specific cell, given that you have 1000 records in?

[Guna13]

How can I generate a workbook consisting of over 1000 worksheets, each derived from the data in a specific cell, given that you have 1000 records in?

 

[Edgar_]

Something like this:

Sub ksdfj()
    dim s as range
    set s = selection ' or some range
    
    dim wb as workbook
    set wb = workbooks.add
    
    dim ws as worksheet
    dim c as range

    for each c in s
        set ws = wb.sheets.add
        ws.cells(1, 1) = c.value
    next c
End Sub

 

[Guna13]

Something like this:

Sub ksdfj()
    dim s as range
    set s = selection ' or some range
   
    dim wb as workbook
    set wb = workbooks.add
   
    dim ws as worksheet
    dim c as range

    for each c in s
        set ws = wb.sheets.add
        ws.cells(1, 1) = c.value
    next c
End Sub

is this Create 1000 Workbook, where i can see Last row or number of count of workbook request? Please advice

 

[Logit]

Let me play devil's advocate here. Creating a workbook with 1,000 worksheets will most likely overload your computer causing Excel to run extremely slow or at worse ... crash completely.

Is there a different design you can accept that doesn't involve so many worksheets ?

 

[Edgar_]

where i can see Last row or number of count of workbook request? Please advice

In that particular snippet, just set "s" to a range, any range you want. You'll also have to figure out a way to navigate that. As Logit says, it's likely that you will crash the workbook, possibly losing important data. I do not question why you want to do it, I just tell you how you could.

 

[Guna13]

We are currently gathering information from over 2,000 suppliers. Our plan is to distribute individualized emails with attachments for each supplier. However, to manage the process efficiently, we will divide the task into smaller batches. We will create 500 or 1,000 sets of workbooks and send emails to the corresponding suppliers in each batch. Once we complete the initial batch, we will proceed with the next set of emails until all suppliers have received their respective attachments. Kindly advise on this approach.

this code performance is slow. To create least 10 filles too...

Sub CreateWorkbooksForEachFilter()

   
    Dim wbSource As Workbook, wbNew As Workbook
    Dim wsTemplate As Worksheet, wsValidation As Worksheet, wsBPCode As Worksheet
    Dim filterValue As Range, uniqueValues As Range
    Dim lastRow As Long, newRow As Long
    
    ' Disable screen updating and calculation to improve performance
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
        
    ' Set the source workbook
    Set wbSource = ThisWorkbook
    
    ' Set the source worksheets
    Set wsTemplate = wbSource.Sheets("Template")
    Set wsValidation = wbSource.Sheets("Validation")
    
    If wsTemplate.AutoFilterMode Then wsTemplate.AutoFilterMode = False
    If wsValidation.AutoFilterMode Then wsValidation.AutoFilterMode = False
    
    ' Define the range of unique values in column C of the Validation sheet
    Set uniqueValues = wsValidation.Range("C2:C" & wsValidation.Cells(wsValidation.Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
    
    ' Loop through each unique value in column C of the Validation sheet
    For Each filterValue In uniqueValues
        ' Filter the Template sheet based on the current value
        wsTemplate.Range("A5:AX5").AutoFilter Field:=1, Criteria1:=filterValue.Value
        
        ' Find the last row of filtered data
        lastRow = wsTemplate.Cells(wsTemplate.Rows.Count, "A").End(xlUp).Row
        ' Get the value from column E of the last row
        Dim eValue As Variant
        eValue = wsTemplate.Cells(lastRow, "E").Value
        emailAdr = wsTemplate.Cells(lastRow, "M").Value
        
        ' Check if there is data to copy
        If lastRow > 5 Then ' Assuming data starts from row 3
            ' Create a new workbook
            Set wbNew = Workbooks.Add
            
            ' Set the target worksheet (BP_Code) in the new workbook
            Set wsBPCode = wbNew.Sheets(1)
            wsBPCode.Name = filterValue.Value
            
            ' Copy the filtered data (from A1 to AC, assuming AC is the last column with data) to the BP_Code sheet in the new workbook
            wsTemplate.Range("A1:AC" & lastRow).Copy Destination:=wsBPCode.Cells(1, 1)
            
            For Each ws In wbSource.Sheets
                If ws.Name <> "Template" And ws.Name <> "Validation" Then
                    ' Copy the sheet to the new workbook
                    ws.Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
                    
                    ' Activate the copied sheet
                    Set wsCopied = wbNew.Sheets(wbNew.Sheets.Count)
                    wsCopied.Activate
                    
                    ' Remove gridlines and autofit columns
                    ActiveWindow.DisplayGridlines = False
                    wsCopied.Columns.AutoFit
                End If
            Next ws
            
            ' Save the new workbook in the C:\Test folder with a specific name
            fileName = filterValue.Value & "-" & eValue & ".xlsx"
            wbNew.SaveAs "C:\Test\E-Invoice\" & fileName
            wbNew.Close False ' Close the workbook without saving changes
            
            ' Update Validation sheet
            wsValidation.Cells(filterValue.Row, "E").Value = "C:\Test\E-Invoice\" & fileName
            wsValidation.Cells(filterValue.Row, "F").Value = emailAdr
        End If
        
        ' Clear the filter
        wsTemplate.AutoFilterMode = False
        
        ' Allw Excel to process events
        DoEvents
    Next filterValue
    
    
    
   
    ' Enable screen updating and calculation
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Workbooks created successfully.", vbInformation
End Sub