VBA Loop - copy range, paste on another worksheet, save as one drive path with cell as name, do the same for the next row until blank

[merquiaga]

Hi VBA Magicians!

This is my first post here because I'm pulling my hair out trying to get this to work. I would GREATLY appreciate any help.

Here's what I'm trying to do:

1. Copy range A2:AN2 on Sheet named "Paste"
2. Paste on another worksheet named "Template"
3. Save as one drive path (multiple users so the User name has to be dynamic)
"C:\Users\" & Environ$("Username") & "\OneDrive - COMPANY\Documents - Location\"
4. Save Filename as cell AO2 on "Template" sheet
5. Go back and repeat process but this time using row 3 on Sheet named "Paste"

The following is what I have so far (copied and pasted from various other posts) but it stops at the first A2:AN2 and doesn't move onto A3:AN3 after saved

Dim src As Workbook
Dim SaveName As String
Dim wb As Workbook
Dim dst As Workbook

Set src = ActiveWorkbook

For Each c In Range("A2:A100")
Sheets("Paste").Select
Range("A2:AN2").Select
Selection.Copy
Sheets("Template").Select
Range("A2").Select
ActiveSheet.Paste
i = c.Row
SaveName = Sheets("Template").Range("AO" & i).Text
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("Username") & "\OneDrive - COMPANY\Documents - Location\"s\" & _
SaveName & ".xlsm"
i = i + 1
Next c
End Sub


Thank you in advance!!

 

[merquiaga]

@JLGWhiz your code here VBA to save each row in new workbook with header using name column as filename
is so close what I need! Any chance you can help me?

Before it saves in your code below I need to:
1. Copy row 2 from "Paste" sheet (Data is from column A to AN)
2. Paste onto row 2 on another sheet called "Template"
3. Then save the whole workbook (not just the sheet) as macro enabled and name it column A + space + D + Space + B from either sheet
4. Then it can refilter to the next row...

Dim sh As Worksheet, lr As Long, rng As Range, eRng As Range, c As Range, wb As Workbook
Set sh = Sheets("Paste") 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
sh.Columns("AP").Insert
rng.AdvancedFilter xlFilterCopy, , sh.Range("AP2"), Unique:=True
Set eRng = sh.Range("AP2", sh.Cells(Rows.Count, 42).End(xlUp))
    For Each c In eRng
            Set wb = Workbooks.Add
            sh.Range("A1:AN1").Copy wb.Sheets(1).Range("A1")
            sh.Range("A2:A" & lr).AutoFilter 1, c.Value
            rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2)
            i = c.Row
            SaveName = Sheets("Paste").Range("AO" & i).Text
            wb.SaveAs ThisWorkbook.Path & "\" & _
            SaveName & ".xlsm"
            sh.AutoFilterMode = False
wb.Close False
Set wb = Nothing
    Next
sh.Columns("AP").Delete
End Sub

Any help at all I would really appreciate. Thanks