Forum Discussion
AlremeithiMohamed
Sep 12, 2021Copper Contributor
....
.
- Sep 12, 2021
This 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
AlremeithiMohamed
Sep 12, 2021Copper Contributor
..........
HansVogelaar
Sep 12, 2021MVP
This 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- AlremeithiMohamedSep 12, 2021Copper Contributor
..........