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!
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).Valuebut 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).ValueI 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
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.