VBA Loop to copy & paste and File Save as..

[Kristylee0228]

Hi Everyone, I am working on a Loop that I need to do the following: I have an active worksheet open with a list of Employees. I have the Loop locating a folder and opening a template. I am having a hard time finding out how to copy and paste Row 2, Column A, B and C of the Active Worksheet into the Template Columns D2, D3 and D4, respectively. Once the copy and paste is complete, I need the Loop to save the Template with the name in Column D2. Close the File, re-open the Template, copy & paste Row 3 from Active Sheet, etc... there maybe as many as 200+ names in the Active Sheet. Any help would be greatly appreciated. Below is the code I have so far.... (it's not much..)

Sub CollectorListLoop()

Dim MyFolder As String, MyFile As String


With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    MyFolder = .SelectedItems(1)
    Err.Clear
End With

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

MyFile = Dir(MyFolder & "\", vbReadOnly)

Do While MyFile <> ""
    DoEvents
    On Error GoTo 0
   
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
    Sheets("collectors").Select
    Range("A2").Select
    Selection.Copy
Workbooks.Open Filename:="\\ncbfs1\businessintelligence\Automation\QA\LoopforCollectorList\NCB QA Scorecard_RPC_TEMPLATE.xlsm"
    Sheets("RPC Call 1").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Range("A4").Select
    Application.CutCopyMode = False

   
Workbooks(MyFile).Close SaveChanges:=False
MyFile = Dir

Loop
Application.ScreenUpdating = True

End Sub

 

[GWteB]

In order for others to help you with your request, this requires further explanation of what you want. Below I try to sum up what you're saying, supplemented with the questions this raises:
-starting position is the active sheet within the workbook which contains the macro (start sheet);
- open an existing template file within a specific disk folder (the first occurence in that folder) and get it ready to paste in (which sheet?);
- on start sheet, cells A2 through C2 >> COPY;
- just opened template, cells D2 through D4 >> target range to PASTE in;
- save template using a different name (in same folder?), as of text in cell D2 (start sheet or template makes no diference because cell D2 was copied a moment ago);
- close template;
- re-open template (same one as before, or the just saved one, or the next found file within the disk folder?);
- on start sheet, cells A3 through C3 >> COPY;
- which workbook, which sheet, which range to paste in?
- the latter in which the paste action took place, has it to be saved or "Saved As" using a different name? If "Saved As", which name ?
- are there more files involved ?
- if yes, in what way?
- within the Do While Loop: which actions are the same every turn and which are not?

Keep in mind that you know what data you are dealing with and that it goes without saying for you, but for others at a distance it remains guesswork if you're not complete in your explanation.

 

[Kristylee0228]

I apologize for not being more clear. I hope this is a better explanation. There will be 2 sheets already open. One being the Macro Sheet & the other being the Employee List. (ActiveSheet that I am copy & pasting into the template.)
I have the Macro copying from the Employee List, Sheet "collectors", columns A2, B2, & C2. Then pasting into the Template, Sheet "RPC Call 1", columns D2, D3 & D4.
I need the Macro to save the Template as "ScoreCard_RPC_<values in cell D2>. It will be saved in a Once this is saved, the Macro should close it. Then re-open the original blank Template. going back to the Employee List file (is already open) and copying the next row A3, B3 and C3 and pasting into the Template. Saving as "ScoreCard_RPC_<values in cell D2>. The file will be saved in the same folder... Or I can create a Sub-Folder. The copy and paste are all the same except that in the Employee List, the Macro needs to move down the list of Employees. I see now where I currently have my loop opening files in a folder, whereas I need the Loop to copy, paste and save as the values in a cell, close the file and re-open Template. I hope this is a bit more clear. And I do appreciate the help. I am new to Loops... but work pretty well with Macros. Thank you so much!

 

[GWteB]

See if this works for you ...

Sub CollectorListLoop()

    Dim oWsSrc As Worksheet, oWsDest As Worksheet
    Dim rng As Range, c As Range
    Dim sFileName As String

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    ' the "Employee List" worksheet to copy from
    Set oWsSrc = ActiveSheet

    ' obtain source range
    With oWsSrc
        Set rng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With

    For Each c In rng
        ' pull file name suffix from column D (same row)
        sFileName = c.Offset(0, 3).Value
        
        ' if suffix is not empty: proceed (if it's empty any previous file without suffix will be overwritten)
        If Not Len(sFileName) = 0 Then
        
            ' re-open template with the "RPC Call 1" worksheet to paste in
            Set oWsDest = Workbooks.Open(Filename:="\\ncbfs1\businessintelligence\Automation\QA\LoopforCollectorList\" & _
                                                   "NCB QA Scorecard_RPC_TEMPLATE.xlsm").Sheets("RPC Call 1")
            With oWsDest
                sFileName = .Parent.Path & "\" & "ScoreCard_RPC_" & sFileName & ".xlsm"
                c.Resize(1, 3).Copy
                .Range("D2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                .SaveAs Filename:=sFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
                .Parent.Close
            End With
        End If
    Next c

    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub