Macro that will Copy, Create, Paste data from a table on a loop.

[Coyotex3]

Hello I have The following information

Book2.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1								Check Request Format
2
3		Date Requested
4		Approved By
5
6
7
8
9		Name
10		Address
11		Phone Number
12		Amount
13		Email Address
14
15		Signature
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sheet2

Book2.xlsx
	A	B	C	D	E	F
1	Date Requested	Dec-21
2	Approved By	John Doe
3
4
5	Checks	Name	Address	Phone Number	Amount	Email Address
6	1	James Band	123 American Eagle	111-111-1111	$ 1,000,000.00	JamesBand 123 American Eagle
7	2	Williams Will	124 American Eagle	111-111-1112	$ 1,000,000.00	WilliamsWill 124 American Eagle
8	3	Mighty Mac	125 American Eagle	111-111-1113	$ 1,000,000.00	MightyMac 125 American Eagle
9	4	Rapid Lightning	126 American Eagle	111-111-1114	$ 1,000,000.00	RapidLightning 126 American Eagle
10	5	Vanishing Cloud	127 American Eagle	111-111-1115	$ 1,000,000.00	VanishingCloud 127 American Eagle
11	6	Stalking Wolf	128 American Eagle	111-111-1116	$ 1,000,000.00	StalkingWolf 128 American Eagle
12	7	Swimming Bird	129 American Eagle	111-111-1117	$ 1,000,000.00	SwimmingBird 129 American Eagle
13	8	Sweet Home Alabama	130 American Eagle	111-111-1118	$ 1,000,000.00	SweetHomeAlabama 130 American Eagle
14
15
16
17
18
19
20
Sheet1

What I would like to do is to be able to copy sheet2 and paste it as "Check1." Then I want Excel to go to the second table(Sheet1) and copy ("B6:F6") and to PasteSpecial Transpose:=True into Worksheet("Check1") Range("C9").

Next step would be to once again copy Sheet2 and paste it as "Check2" this time. Then to go back to Sheet1 and this time copy("C7:F7") and PasteSpecial Transpose:=True into Worksheet("Check2") Range("C9") and so forth.

I would like for the code to do this until the end of the table on sheet two which may vary in length depending on the day.

Here is the code I had

Sub CopySheet()

    Worksheets("Sheet2").Copy After:=Worksheets("Sheet2")
    ActiveSheet.Name = "Check1"
    Worksheets("Sheet1").Range("B6:F6").Copy
    Worksheets("Check1").Range("C9").PasteSpecial Transpose:=True
    Worksheets("Sheet2").Copy After:=Worksheets("Check1")
    ActiveSheet.Name = "Check2"
    Worksheets("Sheet1").Range("B7:F7").Copy
    Worksheets("Check2").Range("C9").PasteSpecial Transpose:=True
End Sub

 

[DanteAmor]

Try this:

Sub CopySheet()
  Dim i As Long
  With Sheets("Sheet1")
    For i = 6 To .Range("A" & Rows.Count).End(3).Row
      Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
      ActiveSheet.Name = "Check" & i - 5
      ActiveSheet.Range("C9").Resize(5).Value = Application.Transpose(.Range("B" & i).Resize(, 5).Value)
    Next
  End With
End Sub

 

[Coyotex3]

Try this:

Sub CopySheet()
  Dim i As Long
  With Sheets("Sheet1")
    For i = 6 To .Range("A" & Rows.Count).End(3).Row
      Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
      ActiveSheet.Name = "Check" & i - 5
      ActiveSheet.Range("C9").Resize(5).Value = Application.Transpose(.Range("B" & i).Resize(, 5).Value)
    Next
  End With
End Sub

This absolutely works! Thank you!!

 

[DanteAmor]

Im glad to help you, thanks for the feedback.

 

[Coyotex3]

Im glad to help you, thanks for the feedback.

Thank you for helping. This is the first step for this Macro and I will more than likely play around with it in order to try to expand on it. Hope you are around to help out then!