Sep 12 2021 03:44 AM - edited Sep 13 2021 07:08 PM
Sep 12 2021 03:52 AM
You cannot do that with Fill Series as far as I know.
Enter the following formula in O1:
=RIGHT("000000"&BASE(ROW()-1,13),6)
Fill down as far as you want.
Sep 12 2021 04:39 AM
Change the number 13 in the formula. It is 10+the number of letters that you want.
So for example, if you want ABCDEF, change 13 to 16, and if you want ABCD, change it to 14.
Sep 12 2021 07:35 AM
A worksheet in an Excel workbook (*.xlsx, *.xlsb or *.xlsm) has 1048576 rows.
The number of worksheets in a workbook is limited by the available memory. In a recent dicussion someone managed to create more than 65000 sheets in a workbook.
The formula in my previous reply could have been simpler:
=BASE(ROW()-1,13,6)
If you fill the first 1000000 rows on the first sheet, you could continue on the second sheet with
=BASE(ROW()-1+1000000,13,6)
and on the third sheet with
=BASE(ROW()-1+2000000,13,6)
etc.
Sep 12 2021 10:34 AM
Run the following macro. I'd test it with a small number of sheets and rows first.
Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
For i = 1 To NumSheets
Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
With Wsh.Range("A1:A" & NumRows)
.Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
End With
DoEvents
Next i
Application.DisplayAlerts = False
Wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sep 12 2021 11:35 AM
This version will ask you which column you want to use.
Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Col As String
Dim Rng As Range
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Col = InputBox(Prompt:="In which column do you want the entries (A, B, ...)?")
On Error Resume Next
Set Rng = Range(Col & 1)
If Err Then
Beep
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
For i = 1 To NumSheets
Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
With Wsh.Cells(1, Col).Resize(NumRows)
.Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
End With
DoEvents
Next i
Application.DisplayAlerts = False
Wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sep 12 2021 11:39 AM
I'm not sure I understand what you want, but here is a version that will fill multiple columns:
Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
For i = 1 To NumSheets
Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
Wsh.Range("A1").Resize(NumRows).Value = "This"
Wsh.Range("B1").Resize(NumRows).Value = "That"
Wsh.Range("C1").Resize(NumRows).Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D1").Resize(NumRows).Value = "Other"
Wsh.Range("E1").Resize(NumRows).Value = "Something"
DoEvents
Next i
Application.DisplayAlerts = False
Wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sep 12 2021 12:12 PM
SolutionThis version will create a text file; it will prompt you for the folder and filename.
It'll be slow, though.
Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
Dim Filename As Variant
Dim f As Integer
Dim r As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
For i = 1 To NumSheets
Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
Wsh.Range("A1").Resize(NumRows).Value = "This"
Wsh.Range("B1").Resize(NumRows).Value = "That"
Wsh.Range("C1").Resize(NumRows).Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D1").Resize(NumRows).Value = "Other"
Wsh.Range("E1").Resize(NumRows).Value = "Something"
DoEvents
Next i
Application.DisplayAlerts = False
Wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Filename = Application.GetSaveAsFilename(FileFilter:="Text File (*.txt),*.txt", Title:="Save to Text File")
If Filename = False Then
Exit Sub
End If
f = FreeFile
Open Filename For Output As #f
For i = 1 To NumSheets
For r = 1 To NumRows
Print #f, Worksheets(i).Range("C" & r).Text
Next r
Next i
Close #f
End Sub
Sep 12 2021 01:16 PM
Does this do what you want?
Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
Dim Filename As Variant
Dim f As Integer
Dim r As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
For i = 1 To NumSheets
Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
Wsh.Range("A1:E1").Value = Array("Header 1", "Header 2", "Header 3", "Header 4", "Header 5")
Wsh.Range("A2").Resize(NumRows).Value = "This"
Wsh.Range("B2").Resize(NumRows).Value = "That"
Wsh.Range("C2").Resize(NumRows).Formula = "=BASE(ROW()-2+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D2").Resize(NumRows).Value = "Other"
Wsh.Range("E2").Resize(NumRows).Value = "Something"
Wsh.Range("A" & NumRows + 2 & ":E" & NumRows + 2).Value = Array("Footer 1", "Footer 2", "Footer 3", "Footer 4", "Footer 5")
DoEvents
Next i
Application.DisplayAlerts = False
Wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Filename = Application.GetSaveAsFilename(FileFilter:="Text File (*.txt),*.txt", Title:="Save to Text File")
If Filename = False Then
Exit Sub
End If
f = FreeFile
Open Filename For Output As #f
For i = 1 To NumSheets
For r = 1 To NumRows + 2
Print #f, Worksheets(i).Range("C" & r).Text
Next r
Next i
Close #f
End Sub
Sep 12 2021 01:51 PM
Here it is split into two separate macros:
Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
For i = 1 To NumSheets
Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
Wsh.Range("A1:E1").Value = Array("Header 1", "Header 2", "Header 3", "Header 4", "Header 5")
Wsh.Range("A2").Resize(NumRows).Value = "This"
Wsh.Range("B2").Resize(NumRows).Value = "That"
Wsh.Range("C2").Resize(NumRows).Formula = "=BASE(ROW()-2+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D2").Resize(NumRows).Value = "Other"
Wsh.Range("E2").Resize(NumRows).Value = "Something"
Wsh.Range("A" & NumRows + 2 & ":E" & NumRows + 2).Value = Array("Footer 1", "Footer 2", "Footer 3", "Footer 4", "Footer 5")
DoEvents
Next i
Application.DisplayAlerts = False
Wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub SaveToText()
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim NumRows As Long
Dim Filename As Variant
Dim f As Integer
Dim r As Long
Filename = Application.GetSaveAsFilename(FileFilter:="Text File (*.txt),*.txt", Title:="Save to Text File")
If Filename = False Then
Exit Sub
End If
f = FreeFile
Open Filename For Output As #f
Set Wbk = ActiveWorkbook
For Each Wsh In Wbk.Worksheets
NumRows = Wsh.Range("C" & Wsh.Rows.Count).End(xlUp).Row
For r = 1 To NumRows
Print #f, Wsh.Range("C" & r).Text
Next r
Next Wsh
Close #f
End Sub
Sep 12 2021 12:12 PM
SolutionThis version will create a text file; it will prompt you for the folder and filename.
It'll be slow, though.
Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
Dim Filename As Variant
Dim f As Integer
Dim r As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
For i = 1 To NumSheets
Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
Wsh.Range("A1").Resize(NumRows).Value = "This"
Wsh.Range("B1").Resize(NumRows).Value = "That"
Wsh.Range("C1").Resize(NumRows).Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D1").Resize(NumRows).Value = "Other"
Wsh.Range("E1").Resize(NumRows).Value = "Something"
DoEvents
Next i
Application.DisplayAlerts = False
Wbk.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Filename = Application.GetSaveAsFilename(FileFilter:="Text File (*.txt),*.txt", Title:="Save to Text File")
If Filename = False Then
Exit Sub
End If
f = FreeFile
Open Filename For Output As #f
For i = 1 To NumSheets
For r = 1 To NumRows
Print #f, Worksheets(i).Range("C" & r).Text
Next r
Next i
Close #f
End Sub