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

merquiaga · Jul 13th 2021

Hi VBA Magicians!

This is my first post 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

Code

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

Display More

Thanks in advance!!

Maggie

**royUK** · Jul 18th 2021

Welcome to the Forum. Please read the Forum Rules to understand how the Forum works and why I have added Code Tags to your post

All VBA code posted in the forum must be wrapped in code tags, which you omitted, including single-line code snippets.Be sure to use them in future posts.

How to use code tags

Just highlight all of the code and press the <> in the post menu above button to add the code tags.

Thanks.

Justin Doward · Jul 19th 2021

Hi,

You can try this code:

Code

Sub LineCopy()
Application.ScreenUpdating = False
Dim MyCpyArr
Dim SaveName As String
Dim LstRw As Long
Dim src As Workbook: Set src = ActiveWorkbook
Dim ws1 As Worksheet: Set ws1 = Sheets("Paste")
Dim ws2 As Worksheet: Set ws2 = Sheets("template")
Dim wb As Workbook
Dim wsCPY As Worksheet
LstRw = ws1.Cells(Rows.Count, 1).End(xlUp).Row ' finds last row in paste worksheet
Application.DisplayAlerts = False
For i = 2 To LstRw
ws1.Cells(i, 1).Resize(1, 40).Copy ws2.Cells(2, 1).Resize(1, 40)
MyCpyArr = ws2.UsedRange
SaveName = ws1.Range("AO" & i).Text
Set wb = Workbooks.Add()
Set wsCPY = wb.Sheets(1)
wsCPY.Range("A1").Resize(UBound(MyCpyArr, 1), UBound(MyCpyArr, 2)).Value2 = MyCpyArr
wb.SaveAs Filename:="C:\Test\" & SaveName
wb.Close
Next i
ws2.Cells(2, 1).Resize(1, 40).Clear


Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Display More

I have it working in this workbook, you need to create a directory on your C drive called "c:\test" just press the button on the template sheet:

linecopy.xlsb

I do not know how the onedrive directory works, but if this code is doing some of what you want I can have a look working out the directory.

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

Participate now!

Share

Tags