how to move down 1 row for every loop until cell empty - vba

Question

How do I move down 1 row for every loop until cell empty in column A?
I need to start on Row 5 copy to another workbook then loop to the next row (Row6) until contents are empty.
Here is my code
Sub Macro3()
'''
Do
''GRAB A ROW
Windows("theFILE2.working.xlsm").Activate
Rows("5:5").Select
Selection.Copy
Workbooks.Open "D:\folder1\folder2\Projects\The FILES\New folder\OVERVIEW TEMPLATE(macro edition)(current).xlsm"
Windows("OVERVIEW TEMPLATE(macro edition)(current).xlsm").Activate
Sheets("LISTS").Select
Rows("4:4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Windows("OVERVIEW TEMPLATE(macro edition)(current).xlsm").Activate
Sheets("PLANT OVERVIEW").Select
''SAVE AS
Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
FileName1 = Range("N1").Value
FileName2 = Range("A1").Value
Path = "D:\folder1\folder2\Projects\The FILES\theFILES\" & FileName1 & "\"
ActiveWorkbook.SaveAs Filename:=Path & FileName2 & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
Loop
End Sub
Thankyou in advanced!

Answer 1

I see you're new to VBA, and there are some concepts you're picking up pretty quickly. Recording macros in Excel is a great way to find out how you could do something in Excel. However, there are some drawbacks to the way Excel does it also. Here are a few concepts that will help:
Don't use Selection, ActiveCell, ActiveSheet, Select, Activate, etc. unless you absolutely have to. I know that's what the Macro Recorder in Excel does, but if you don't do it exactly right, it can cause errors, especially when you start working with multiple workbooks!
Much better to assign an object, and use that object to do what you want to do. In the code below, I assigned the Workbooks and worksheets to objects and used those to get stuff done. Ranges are also common objects to use.
Related to that, make sure to always fully qualify your objects. For example, you can write code like this: Var1 = Cells(1, 1).Value but it will get the value from cell A1 in the Active Worksheet, not necesarily the worksheet or workbook you intended. Much better to write it this way: Var1 = wksSource.Cells(1, 1).Value I did specify a sheet name "Sheet1" for your source workbook - change it to the actual name of the sheet you're copying from.
I assigned the most common strings to Constants at the top. There's a balance between assigning every string to a constant and using only in-line strings (for example, some might assign the sheet names like "LISTS" to a constant), but if they're only used once and in a prominent place, I don't worry about assigning a constant for it. But especially when the value is used multiple places, a constant makes it easier for when you want to re-use the code for a similar task. I also put a constant in there for the Source Path, although that's not required if the workbook is already open.
I also declared all the variables at the top - some languages and programmers do it differently, but I like to be able to see what's being used at the beginning.
Notice the While specifier on your Do ... Loop. This will only loop while there is a value in the first column of the current row.
Here's how I would write the code for your task:
Sub Macro3()
Dim SourceRow As Long
Dim DestRow As Long
Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Dim FullFileName As String
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim wksDest2 As Worksheet
Const scWkbSourcePath As String = "D:\folder1\folder2\Projects\" ' For example
Const scWkbSourceName As String = "theFILE2.working.xlsm"
Const scWkbDest1Path As String = "D:\folder1\folder2\Projects\The_FILES\New_folder\"
Const scWkbDest1Name As String = "OVERVIEW TEMPLATE_macro edition_current_.xlsm"
Const scWkbDest2Path As String = "D:\folder1\folder2\Projects\The_FILES\theFILES\"
Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name
SourceRow = 5
DestRow = 4
Do While wksSource.Cells(SourceRow, 1).Value <> ""
' Open the template workbook
Set wkbDest = Workbooks.Open(scWkbSourcePath & scWkbDest1Name)
Set wksDest = wkbDest.Sheets("LISTS")
''COPY A ROW
wksSource.Rows(SourceRow).Copy Destination:=wksDest.Rows(DestRow)
Application.CutCopyMode = False
With wksDest.Rows(DestRow).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
wkbDest.Activate
Set wksDest2 = wkbDest.Sheets("PLANT OVERVIEW")
''SAVE AS
FileName1 = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
Replace(wksDest2.Range("N1").Value _
, ".", "_") _
, "/", "_") _
, "\", "_") _
, "?", "_") _
, "|", "_") _
, "<", "_") _
, ">", "_") _
, ":", "_") _
, "*", "_") _
, """", "_")
FileName2 = wksDest2.Range("A1").Value
Path = scWkbDest2Path & FileName1 & "\"
If Len(Dir(Path, vbDirectory)) = 0 Then
MkDir Path
End If
FullFileName = Path & FileName2 & ".xlsx"
wkbDest.SaveAs Filename:=FullFileName, FileFormat:=xlOpenXMLWorkbook
wkbDest.Close
' Best practice to set objects to Nothing before re-using an object variable
Set wksDest = Nothing
Set wksDest2 = Nothing
Set wkbDest = Nothing
' Move down 1 row for source sheet
SourceRow = SourceRow + 1
Loop
End Sub
Edit
Some notes and things I learned regarding Folder and File name characters:
Although parentheses can be used in filenames, I wasn't able to get your original filename to save - but removing the parentheses solved the problem.
Since you're creating file and folder names from (potentially dirty) data, you should clean up (remove or replace with _) the characters that can't be used in those names: \ / | ? < > : * "
I found this on a Microsoft page for Naming Files, Paths, and Namespaces:
Do not end a file or directory name with a space or a period.
Although it is allowed inside a file name, a full stop (.) cannot be the last char of a folder name, which is generally where you find it in a text string. Besides, it can be confusing and occasionally cause problems within a file name, so I'd recommend replacing them all.
The Trim() function can be used to remove spaces at the end of a folder name. Be aware that within the string, it also changes multiple spaces in a row to a single space.
Especially since you're creating folders from data, you need to make sure the folder exists before saving a file to it. MkDir is the command for this.
If your template workbook isn't open when you start, you may need to specify the path as well in the Open() statement.