VBA Macro to copy paste and create and save a new from from data file

[ARIF0204]

Hi all: I need help on the following:

Scenario:
I have a master database of information in Excel Called Data. It has a lot of fields. I have a form that I need to automatically filled with each row data from the master and then a save the form with a specific style (AgencyName_SiteAddress in a destination folder say C:\Forms) for each row of data.

I can create a macro to copy and paste information from various data cell to appropriate form fields, but I cannot seem to make excel save repeat the process for each row (loop process) and save each file separately. Need some help.

I know it may be seriously complicated for me but I know you guys can do it.

I need this program to make my life easy I have 4500 such rows that I need to manually create a form from (you can understand the frustration! )

Any help would be appreciated.

Since I cannot post the Excel file I am going to give you an example in one line below:

Agency Name	Agency Address	Agency Number	Site Address	Site Number	RowNumber
Agency 1	1 Orange Street	1001	20 Banana Street	5001	1
Agency 2	2 Orange St.	1002	5 Melon St.	5002	2

<tbody>
</tbody>

TabName: Data

The form I have is based on this information in another sheet called Form (TabeName:Form): It looks like below

Section 1:

Agency Name: (cell G3:Ab3)
Agency Address: (Cell G6:AB6)
Agency Number: (Cell C9:E9)

Section 2:

Agency Address: (Cell 613:AB13)
Agency Number: (Cell C13:13)


Thank you guys!


Arif

 

[ARIF0204]

Sorry one correction to the Section 2 :

Site Address (instead of Agency): (Cell 613:AB13)
Site Number: (instead of Agency): (Cell C13:13)

Thanks.

 

[Learning To Excel]

See if this works for you.

Sub Saver()
Dim i As Integer
Dim Temporary As Workbook
Dim CurrentWB As Workbook
Dim CurrentWS As Worksheet
Dim TempString As String

Set CurrentWB = ThisWorkbook
Set CurrentWS = ActiveSheet

    For i = 2 To 4500
        If Cells(i, 1).Value = "" Then
            Exit For
        End If
        
        Set Temporary = Workbooks.Add
        
        CurrentWB.Activate
        TempString = Cells(i, 1).Value & " " & Cells(i, 4).Value
        CurrentWS.Range(Cells(i, 1), Cells(i, 6)).Copy
        Temporary.Activate
        Range("A1").PasteSpecial xlPasteAll
        Temporary.SaveAs TempString & ".xlsx"
        Temporary.Close
    Next i

End Sub