Using VBA/Macros to Duplicate Sheets and Inserting Individual Rows from Table

[donnington]

Hello all,

I am trying to automate a task that I regularly have to do at work however I don't have much experience using VBA/Macros so I was hoping someone could help?

I will try my best to explain what I want to do in words but I have also got a mini sheet below which should make it a lot easier to follow. I have 2 sheets, one called "Table" and one called "Template". The "Table" sheet contains a table (obviously) which has 7 columns and up to 50 rows (changes week on week). I want to extract each individual row from the table and insert it into row 7 on the other sheet called "Template". Since I need to do this up to 50 times, it would be great if I could duplicate the "Template" sheet for each row that I insert. Preferably, I also want to name each sheet based off it's specific code.

Can anyone think of an easy code to use for this on VBA? Do let me know if I need to provide more information.

Table Sheet:

Example.xlsx
	A	B	C	D	E	F	G	H	I	J
1	Column 1	Column 2	Column 3	Column 4	Column 5	Column 6	Column 7		Code
2	09-Dec-20	4,447.00	17-Jan-01	963400.00%	3993	8,155.00	9,254.00		XX 1 YY
3	21-Dec-05	4,660.00	24-Feb-01	948100.00%	4078	9,308.00	9,494.00		XX 2 YY
4	29-Jun-11	8,529.00	21-Aug-24	114000.00%	8866	2,150.00	2,060.00		XX 3 YY
5	09-Jan-16	3,970.00	05-Jan-12	403300.00%	1449	3,295.00	8,049.00		XX 4 YY
6	13-Aug-17	1,288.00	30-Jul-13	562200.00%	2227	6,027.00	3,781.00		XX 5 YY
7	02-Nov-05	2,779.00	19-Jul-07	351600.00%	3930	3,613.00	9,505.00		XX 6 YY
8	21-Feb-17	4,079.00	10-Mar-11	916500.00%	5215	9,699.00	6,471.00		XX no. YY
9	17-May-05	9,498.00	29-Apr-15	206100.00%	2781	3,045.00	8,193.00		XX no. YY
10	12-May-12	8,368.00	29-Apr-21	914600.00%	3730	3,238.00	7,729.00		XX no. YY
11	01-Jul-12	2,294.00	29-Jul-01	137200.00%	8615	7,525.00	3,300.00		XX no. YY
12	04-Aug-21	5,198.00	07-Aug-26	396900.00%	4106	8,234.00	623.00		XX no. YY
13	02-Nov-05	6,655.00	01-Apr-11	387300.00%	9797	7,264.00	2,098.00		XX no. YY
14	26-Feb-21	8,997.00	26-May-26	362100.00%	3561	409.00	2,472.00		XX no. YY
15	27-Jun-09	6,311.00	20-Dec-09	664000.00%	1922	9,061.00	4,054.00		XX no. YY
16	22-Jul-25	6,878.00	06-Dec-11	615500.00%	4049	3,039.00	462.00		XX no. YY
17	17-Oct-10	153.00	12-Jan-09	329700.00%	405	3,064.00	6,732.00		XX no. YY
18	10-Aug-25	8,082.00	31-Aug-16	958300.00%	3862	3,950.00	8,791.00		XX no. YY
19	06-May-26	9,945.00	10-Aug-19	247300.00%	9031	702.00	7,496.00		XX no. YY
20	10-Feb-24	2,122.00	13-Oct-00	750000.00%	7262	1,880.00	8,620.00		XX no. YY
21	06-Jun-07	8,498.00	11-Dec-03	535800.00%	7108	462.00	5,650.00		XX no. YY
22	19-Oct-24	1,912.00	01-Feb-09	775900.00%	8415	4,351.00	8,035.00		XX no. YY
23	04-Nov-23	3,253.00	11-Aug-08	5700.00%	4489	4,720.00	2,082.00		XX no. YY
24	12-Mar-00	2,289.00	04-Aug-21	276500.00%	5198	9,544.00	5,836.00		XX no. YY
25	28-Dec-17	4,859.00	24-Sep-24	532100.00%	9086	9,653.00	1,087.00		XX no. YY
26	08-Dec-10	7,528.00	29-Apr-21	947800.00%	8658	4,713.00	2,631.00		XX no. YY
27	31-Jan-00	5,011.00	29-Jan-08	29000.00%	4243	4,344.00	3,601.00		XX no. YY
28	04-Nov-11	5,663.00	09-Feb-01	320700.00%	3562	511.00	3,823.00		XX no. YY
29	19-Nov-10	3,913.00	25-Nov-03	425900.00%	7092	8,992.00	8,862.00		XX no. YY
30	04-Dec-15	15.00	23-Jun-23	960700.00%	8625	3,987.00	317.00		XX no. YY
31	16-May-13	9,256.00	24-Nov-16	504500.00%	6885	8,891.00	7,698.00		XX no. YY
32	25-Jan-10	1,649.00	30-Dec-25	683800.00%	1944	8,941.00	7,737.00		XX no. YY
33	15-Oct-11	5,361.00	12-Apr-10	717700.00%	7584	8,350.00	3,550.00		XX no. YY
34	19-Jan-19	5,978.00	09-Jan-02	457300.00%	3652	1,960.00	3,467.00		XX no. YY
35	11-Oct-07	7,692.00	12-Jun-18	685100.00%	1710	5,190.00	1,485.00		XX no. YY
36	05-Aug-11	5,458.00	25-Apr-24	636500.00%	7426	684.00	8,802.00		XX no. YY
37	13-Apr-14	8,345.00	27-Apr-25	648400.00%	4525	6,610.00	1,137.00		XX no. YY
38	24-Jan-07	4,225.00	18-Oct-05	91700.00%	9713	6,359.00	5,499.00		XX no. YY
39	20-Jun-23	9,111.00	26-Sep-25	636300.00%	2164	438.00	9,735.00		XX no. YY
40	27-Oct-17	7,278.00	04-Jul-24	838300.00%	31	8,271.00	7,134.00		XX no. YY
41	25-Nov-04	3,298.00	25-Apr-00	130900.00%	5588	5,722.00	3,260.00		XX no. YY
42	03-Feb-08	3,125.00	26-Feb-21	775800.00%	8600	5,434.00	1,098.00		XX no. YY
43	24-Dec-01	1,639.00	21-Jun-07	354000.00%	4919	3,165.00	9,039.00		XX no. YY
44	16-Jan-23	7,270.00	19-Jul-23	261800.00%	5495	4,728.00	421.00		XX no. YY
45	28-Jun-13	9,167.00	31-Oct-18	1900.00%	9352	1,517.00	2,333.00		XX no. YY
46	19-Feb-04	500.00	29-Jun-26	201800.00%	7972	4,366.00	4,107.00		XX no. YY
47	25-Nov-18	8,512.00	30-Jul-10	925700.00%	5973	8,076.00	1,799.00		XX no. YY
48	01-Oct-14	2,607.00	05-Aug-19	885600.00%	5924	2,182.00	4,098.00		XX no. YY
49	27-Aug-25	7,465.00	23-Jun-07	995700.00%	5350	5,318.00	9,547.00		XX no. YY
50	25-Sep-16	505.00	18-Nov-15	446500.00%	6591	2,806.00	2,473.00		XX no. YY
51	27-Oct-26	7,314.00	14-Nov-09	297400.00%	6094	7,109.00	2,173.00		XX no. YY
52	9244	3981	2985	3281	3430	5162	2616		XX no. YY
Table

Cell Formulas
Range	Formula
A2:G52	A2	=RANDARRAY(51,7,0,10000,TRUE)
Dynamic array formulas.

Template sheet:

Example.xlsx
	A	B	C	D	E	F	G	H	I
1
2
3	Title
4
5
6	Column 1	Column 2	Column 3	Column 4	Column 5	Column 6	Column 7
7	Where I want to insert the individual rows
8
9
10
11
12	Random information
13
14
15
16
17
18
19
20
21
22
23
24
Template

Any help would be greatly appreciated!

 

[Takae]

Hope this helps .
This code does not consider the error. If there are duplicates in column I, or if there are characters that cannot be used in the sheet name, an error will occur.

Sub sample()
Dim Dws As Worksheet, Tmpws As Worksheet
Dim LR As Long, i As Long

Set Dws = Sheets("Table")
Set Tmpws = Sheets("Template")
Application.ScreenUpdating = False
With Dws
    LR = .Cells(Rows.count, 1).End(xlUp).Row
    For i = 2 To LR
        Tmpws.Copy After:=Sheets(Worksheets.count)
        ActiveSheet.Name = .Cells(i, 9).Value
        .Range(.Cells(i, 1), .Cells(i, 7)).Copy ActiveSheet.Range("A7")
    Next
End With
Application.ScreenUpdating = True
End Sub

 

[donnington]

Hope this helps .
This code does not consider the error. If there are duplicates in column I, or if there are characters that cannot be used in the sheet name, an error will occur.

Sub sample()
Dim Dws As Worksheet, Tmpws As Worksheet
Dim LR As Long, i As Long

Set Dws = Sheets("Table")
Set Tmpws = Sheets("Template")
Application.ScreenUpdating = False
With Dws
    LR = .Cells(Rows.count, 1).End(xlUp).Row
    For i = 2 To LR
        Tmpws.Copy After:=Sheets(Worksheets.count)
        ActiveSheet.Name = .Cells(i, 9).Value
        .Range(.Cells(i, 1), .Cells(i, 7)).Copy ActiveSheet.Range("A7")
    Next
End With
Application.ScreenUpdating = True
End Sub

This is incredible, I made a few adjustments to avoid errors and it works a dream. Thank you!