Learning VBA, Copy/Paste Loop Help

[Rinzlers]

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.

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

 

[CharlieNVA]

Try activating InputFile.Sheets("Sheet1") before selecting and let me know what happens.

 

[JLGWhiz]

Using ActiveCell is OK if you are making manual input or using the Select and Activate methods throughout your code, but it is really not the best way to work with loops. Bear in mind that rows and columns are represented by index numbers in Excel, and the underlying application always knows where each row and column is located by index. That setup forms a grid of vertical and horizontal lines that make it easy to reference a position on the worksheet by using the Cells property. Notice that Cells is a property and not an object like Range. But if you want to move down a column of data consecutively in a loop, you can first find the last row which contains data in that columb by:

Dim lastRow As Long 'designates lastRow as a long integer
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'Column A last cell with data or formula.

It will get the last cell with data (or formula). You can then use that to create your loop:

Sub t()
Dim lastRow As Long, i As Long
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To lastRow 'Assumes headers in row 1
  With ActiveSheet
   .Range(.Cells(i, 1), .Cells(i, 1).End(xlToRight)).Copy 'This will increment to the next row in each loop
          'and stop when it reaches the last row with data or formula.
   'Continue with pasting action, etc
  End With
 Next
End Sub

 

[Rinzlers]

Hmm good point on not having that line above the Offset line. That said, it still reads an "Object doesn't support this property or method" error which I find somewhat baffling. While not the best way, as @JLHWhiz pointed out, I think this way should suffice in this situation. Very interesting.

InputFile.Sheets("Sheet1").Activate
InputFile.Sheets("Sheet1").ActiveCell.Offset([COLOR=#333333]rowOffset:=1, columnOffset:=0[/COLOR]).Select

 

[JLGWhiz]

Hmm good point on not having that line above the Offset line. That said, it still reads an "Object doesn't support this property or method" error which I find somewhat baffling. While not the best way, as @JLHWhiz pointed out, I think this way should suffice in this situation. Very interesting.

InputFile.Sheets("Sheet1").Activate
InputFile.Sheets("Sheet1").ActiveCell.Offset([COLOR=#333333]rowOffset:=1, columnOffset:=0[/COLOR]).Select

the problem with writing code this way is that you have to tell it where the ActiveCell is by either Activating or Selecting it. And if you use the Activate and Select method, then you have to ensure that you have activated or selected the parent before attempting to do something with the child. Using the direct coding method is much more efficient, and once you get used to it, it is a lot easier to write code with complex logic. The "Object doesn't support..." message usually is caused by trying to use a property that the method was not designed for, or in some cases, typos.

 

[Rinzlers]

Yeah I see what you mean. I appreciate the feedback. As you can see below, I went with your code and really see how much more streamline direct coding makes the process. Earlier it appears I was also having trouble with ensuring that the loop was pulling in the correct active worksheet. Thanks again!

Sub STImacro3()Dim OutputPath As String
Dim lastRow As Long, i As Long
OutputPath = "G:\"
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To lastRow
  With ActiveSheet
   .Range(.Cells(i, 1), .Cells(i, 1).End(xlToRight)).Copy
   
Workbooks.Open (OutputPath & "2017 Master Goal Setting Worksheet.xlsx")
ActiveWorkbook.Sheets("2017 STI Goal Form").Range("C6").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False


ActiveWorkbook.SaveAs Filename:= _
        "G:\HR\Compensation\Incentive Compensation\2017 Comp Cycle\STI\2017 Goal Setting Worksheets\2017 Goal Setting Worksheet -" & Range("C6") & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 ActiveWorkbook.Close SaveChanges:=True
   
   
  End With
 Next
End Sub

 

[JLGWhiz]

Yeah I see what you mean. I appreciate the feedback. As you can see below, I went with your code and really see how much more streamline direct coding makes the process. Earlier it appears I was also having trouble with ensuring that the loop was pulling in the correct active worksheet. Thanks again!

Sub STImacro3()Dim OutputPath As String
Dim lastRow As Long, i As Long
OutputPath = "G:\"
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To lastRow
  With ActiveSheet
   .Range(.Cells(i, 1), .Cells(i, 1).End(xlToRight)).Copy
   
Workbooks.Open (OutputPath & "2017 Master Goal Setting Worksheet.xlsx")
ActiveWorkbook.Sheets("2017 STI Goal Form").Range("C6").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False


ActiveWorkbook.SaveAs Filename:= _
        "G:\HR\Compensation\Incentive Compensation\2017 Comp Cycle\STI\2017 Goal Setting Worksheets\2017 Goal Setting Worksheet -" & Range("C6") & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 ActiveWorkbook.Close SaveChanges:=True
   
   
  End With
 Next
End Sub

Happy to help,
Regards, JLG

 

[HackSlash]

When working with multiple sheets it can really help to have fully qualified absolute references instead of relative references for the same reasons JLG was saying that ActiveCell relative references are undesirable.

If your code lives in a macro sheet that you are coping data from then I suggest you change those references to use "ThisWorkBook". Also, you have a "With ActiveSheet" block where the active sheet changes in the middle of the block. This is difficult for both humans and computers to understand what you are asking for.

This code will need you to specify the sheet name of the source data for it to work:

Sub STImacro3()Dim OutputPath As String
Dim lastRow As Long, i As Long
Dim MasterBook As String

    MasterBook = "2017 Master Goal Setting Worksheet.xlsx"
    OutputPath = "G:\"
    lastRow = ThisWorkbook.Sheets("PUT YOUR SHEETNAME HERE").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        ThisWorkbook.Sheets("PUT YOUR SHEETNAME HERE").Range(.Cells(i, 1), .Cells(i, 1).End(xlToRight)).Copy
        Workbooks.Open (OutputPath & MasterBook)
        Workbooks(MasterBook).Sheets("2017 STI Goal Form").Range("C6").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False


        Workbooks(MasterBook).SaveAs Filename:= _
            "G:\HR\Compensation\Incentive Compensation\2017 Comp Cycle\STI\2017 Goal Setting Worksheets\2017 Goal Setting Worksheet -" & Range("C6") & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        Workbooks(MasterBook).Close SaveChanges:=True
    Next
End Sub