VBA Code to copy and paste data to a form via a loop

[Barry NP]

Hi.
I need some VBA help to copy data from an excel worksheet to a preformatted excel form, the, save the form to my C drive with the code looped to repeat this sequence for each line of data to be copied.

I have the data set in an excel sheet called "DATA" (below) and the form in same excel workbook in the tab called "Form" (bottom table)

Data sheet - Data starts in Cell B6 (row 5 are headers)
DATA:

	A	B	C	D	E	F	G
5	​	Number	Shipping Required Date	Common Name	Destination Addresss	FWDRet Reference	Pick Slip/Move Order Numbers
6	​	Test 1	13/10/2021​	A0135A	TBC address 1	Ref 1	M0-123456 M0-123457
7	​	Test2	31/08/2021​	A0135F	TBC address 1	Ref 2	M0-123458 M0-123459
8	​	Test3	11/10/2021​	A0135J	TBC address 1	Ref 3	M0-123460 M0-123461
9	​	Test4	20/08/2021​	A0202A	TBC address 1	Ref 4	M0-123462 M0-123463 M0-123464
10	​	Test5	16/08/2021​	A0329A	TBC address 1	Ref 5	M0-123465

What I need is code to copy the data in each row from the Data tab and paste the data into the form below in the tab called "Form" in cells B3, B8, B11, B12, B13, B14. In cell B7 the date needs to be the current date.

FORM:

	A	B
1
2
3	Number:	Test1
4	Senders Name
5	Telephone Number
6
7	Date of Request	Needs to be todays date
8	Shipping Required Date	13/10/2021
9	Recipients Name
10	Telephone Number
11	Common Name:	A0135A
12	Destination Address	TBC address 1
13	FwdRet Reference	Ref 1
14	Pick Slip/Move Order Number	M0-123456 M0-123457
15	Full Item Description
16	Individual Item Value
17	Dimensions in Centimetres
18	Weight (Kgs)
19	Do these items contain any information?
20	Are these Items designed or modified forUse or are they Commercial off the Shelf?
21	Programme Name/ Cost Code (for billing purposes)
22	Any specific delivery requirements? (Timed delivery, sameday etc pls note these do incur extra charges)
23	Signature
24	Print Name

Once the form has been populated, I need code to then copy only the sheet "Form" to a new excel workbook and save the file on my C drive in folder FORMS/Current with the filename as in the form cell B3 (above it would be the filename Test1)
I then need to loop the code to repeat the process for each line of data in the "Data" tab, so in this instance it would create 5 separate workbooks each with the Form and each with the filename as in cell B3, i.e. Test1, Test2, Test3, Test4 & Test5.

Any help to achieve this would be gratefully received.

Many thanks,
Barry.

 

[Zot]

Try this

Sub FillForm()

Dim cell As Range, rngData As Range
Dim wsData As Worksheet, wsForm As Worksheet
Dim wb As Workbook

Const strPath As String = "C:\FORMS\Current\"

Application.ScreenUpdating = False

Set wsData = ActiveWorkbook.Sheets("DATA")
Set wsForm = ActiveWorkbook.Sheets("FORM")

Set rngData = wsData.Range("A6", wsData.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    wsForm.Range("B3") = wsData.Range("A" & cell.Row)
    wsForm.Range("B7") = Format(Date, "dd/mm/yyy")
    wsForm.Range("B8") = wsData.Range("C" & cell.Row)
    wsForm.Range("B11") = wsData.Range("D" & cell.Row)
    wsForm.Range("B12") = wsData.Range("E" & cell.Row)
    wsForm.Range("B13") = wsData.Range("F" & cell.Row)
    wsForm.Range("B14") = wsData.Range("G" & cell.Row)
    
    Set wb = Workbooks.Add
    wsForm.Cells.Copy wb.Sheets(1).Range("A1")
    wb.SaveAs strPath & wsForm.Range("B3"), 51
    wb.Close False
Next

Application.ScreenUpdating = True
    
End Sub

 

[Nadamasaqui]

Try this

Sub FillForm()

Dim cell As Range, rngData As Range
Dim wsData As Worksheet, wsForm As Worksheet
Dim wb As Workbook

Const strPath As String = "C:\FORMS\Current\"

Application.ScreenUpdating = False

Set wsData = ActiveWorkbook.Sheets("DATA")
Set wsForm = ActiveWorkbook.Sheets("FORM")

Set rngData = wsData.Range("A6", wsData.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    wsForm.Range("B3") = wsData.Range("A" & cell.Row)
    wsForm.Range("B7") = Format(Date, "dd/mm/yyy")
    wsForm.Range("B8") = wsData.Range("C" & cell.Row)
    wsForm.Range("B11") = wsData.Range("D" & cell.Row)
    wsForm.Range("B12") = wsData.Range("E" & cell.Row)
    wsForm.Range("B13") = wsData.Range("F" & cell.Row)
    wsForm.Range("B14") = wsData.Range("G" & cell.Row)
   
    Set wb = Workbooks.Add
    wsForm.Cells.Copy wb.Sheets(1).Range("A1")
    wb.SaveAs strPath & wsForm.Range("B3"), 51
    wb.Close False
Next

Application.ScreenUpdating = True
   
End Sub

Greetings, @Zot this code was very, very helpful. I have a similar issue. Unlike @Barry NP. instead of saving the results as a string to the C drive. What I would like to do is have my "form" sheet copy over so the data in my "data" range can continue to be copied. I am not sure if that is making sense. Essentially I have a row with data in FY2025, I would like that information to copy over into the LIT Form for as many rows as I have. This would range from 75-100 rows. This is my modified code based on the above.

Sub FillLITForm()

Dim cell As Range, rngFY2025 As Range
Dim wsFY2025 As Worksheet, wsLITForm As Worksheet
Dim wb As Workbook

Const strPath As String = "C:\LITforms\Current\"

Application.ScreenUpdating = False

Set wsFY2025 = ActiveWorkbook.Sheets("FY2025")
Set wsLITForm = ActiveWorkbook.Sheets("LITForm")

Set rngFY2025 = wsFY2025.Range("A3", wsFY2025.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngFY2025
wsLITForm.Range("a1") = wsFY2025.Range("B" & cell.Row)
wsLITForm.Range("B2") = wsFY2025.Range("C" & cell.Row)
wsLITForm.Range("B6") = wsFY2025.Range("A" & cell.Row)
wsLITForm.Range("B10") = wsFY2025.Range("D" & cell.Row)
wsLITForm.Range("B4") = wsFY2025.Range("E" & cell.Row)
wsLITForm.Range("B5") = wsFY2025.Range("F" & cell.Row)
wsLITForm.Range("B8") = wsFY2025.Range("G" & cell.Row)
wsLITForm.Range("B7") = wsFY2025.Range("H" & cell.Row)

Set wb = Workbooks.Add
wsLITForm.Cells.Copy wb.Sheets(1).Range("A1")
wb.SaveAs strPath & wsLITForm.Range("a1"), 51
wb.Close False
Next

Application.ScreenUpdating = True

End Sub

Do you have any suggestions on how I can change this code to allow that to happen?