Hjælp til VBA kopi af celler til andet ark i Loop

Hejsa,

Jeg er nybegynder i VBA og har googlet mig frem til diverse kode derfor er jeg ikke sikker på det er helt optimalt bygget. Så jeg lytter gerne hvis der er en smartere måde / idé til at optimere.

Jeg har en skabelon med 2 ark - jeg kan ud fra en markering på ark1 opretter Windows biblioteker som navngives efter cellens værdi som typisk er adresser, under hver mappe kopiere jeg ark2 ind i som en selvstændig fil uden reference til den oprindelig skabelon fil.

Jeg vil gerne i ark2 have nogen felter automatisk udfyldt med info fra ark1, inden det bliver en selvstændig fil.

Adresserne står i Kolonne E på ark1 - på samme række som adressen, vil jeg gerne kopiere fra Kolonne B, C & D over i B7, B8, B9 på ark2

Jeg har forsøgt med ActiveCell.Offset(0, -1) i loop men uden held.

Jeg håber overstående giver mening.

kode ser således ud.

Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count

For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(strPath & "\" & Rng(r, c), vbDirectory)) = 0 Then

Path = (strPath & "\" & Rng(r, c))

MkDir Path
ChDir Path
            Application.ScreenUpdating = False
            Worksheets("ark2").Visible = True
            Worksheets("ark2").Copy
            Filename = ActiveSheet.Name
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=52
            Application.DisplayAlerts = True

' Indsætter adresse i ark2
Cells(3, 2) = (Rng(r, c))
' Indsæt i ark2
Cells(7, 2) = ActiveCell.Offset(0, -1)

'Pæn lukning af nyoprettet fil
    If Application.Workbooks.Count = 1 Then
       
        Application.Quit

    Else
   
        ActiveWorkbook.Close
       
      End If
            Application.ScreenUpdating = True

' Chdir bib op ellers kan man ikke slette før ark1 er lukket.
ChDir ".."

On Error Resume Next
End If

r = r + 1

Loop

Next c

End If