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
Thanks A Lot! Good Night!
HansVogelaar
Sep 12, 2021MVP
Good night!
- AlremeithiMohamedSep 13, 2021Copper Contributor
..........
- AlremeithiMohamedSep 13, 2021Copper Contributor
..........