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

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:

1. 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.

2. 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.

3. 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.

4. 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.

5. 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.