Hello Everybody!
I've been reading these forums for over a year now and have used them to parse my way through understanding VBA and beginning to build macros. The forums have been a real asset to my learning so I really appreciate any advice you all can provide.
I come to you all for help regarding how you setup loops. I fully admit this code is probably messy and not straight forward but I'm trying my best .
I'm attempting to copy a list with hundreds of names unique to each row (and 3 columns) from one workbook to hundreds of new workbooks specific to one name. As of right now, I have the code below that successfully creates one workbook but then fails when the code attempts to move down one cell (cell A3) to begin copying the next name.
I believe what I need is a new equation of some sort (note the Dim y As Long) but alas I'm somewhat stuck on what logic to implement and where. I appreciate it and happy coding.
I've been reading these forums for over a year now and have used them to parse my way through understanding VBA and beginning to build macros. The forums have been a real asset to my learning so I really appreciate any advice you all can provide.
I come to you all for help regarding how you setup loops. I fully admit this code is probably messy and not straight forward but I'm trying my best .
I'm attempting to copy a list with hundreds of names unique to each row (and 3 columns) from one workbook to hundreds of new workbooks specific to one name. As of right now, I have the code below that successfully creates one workbook but then fails when the code attempts to move down one cell (cell A3) to begin copying the next name.
I believe what I need is a new equation of some sort (note the Dim y As Long) but alas I'm somewhat stuck on what logic to implement and where. I appreciate it and happy coding.
Code:
Sub STImacro()
Dim InputFile As Workbook
Dim OutputFile As Workbook
Dim InputPath As String
Dim OutputPath As String
Dim y As Long
y = ActiveCell.Row + 1
Dim x As Long
'Set path for Input & Output
FileInputPath = "G:\"
OutputPath = "G:\"
Set InputFile = ActiveWorkbook
Set OutputFile = Workbooks.Open(OutputPath & "A.xlsx")
'Now ready to copy from the input file
'Selects first cell/first line of data
InputFile.Sheets("Sheet1").Activate
InputFile.Sheets("Sheet1").Range("A1").Select
'Begin Loop
Do Until IsEmpty(ActiveCell)
'Copy cells in InputFile
InputFile.Sheets("Sheet1").Range("A2", Range("A2").End(xlToRight)).Copy
'Paste cells in OutputFile
OutputFile.Sheets("Sheet A").Activate
OutputFile.Sheets("Sheet A").Range("C6").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
'Save the newly created Form with name inserted and close the new file
OutputFile.SaveAs Filename:= _
"G:\Form -" & Range("C6") & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=True
'Return to Input File and step down 1 row
InputFile.Sheets("Sheet1").ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Select
Loop
'Close InputFile & OutputFile
InputFile.Close
OutputFile.Close
End Sub