Looping a macro for each row into a template

[hamistasty]

I'm trying to make a button that transfers all the raw data in each row of that tab into a template tab that replicates itself and transfers the data of each row over until there are no rows left to transfer. In sheet1 each row contains a set of data that I'm copying and pasting into a template in the next excel tab called FIC001.

Basically, the raw data is copied and pasted into specific cells, then the FIC001 page is replicated into a new tab using 'create a copy', then the sheet1 tab is selected the same is done to the next row of data into that newly created copy of FIC001.

So basically a loop of what I've said that ends when column C in Sheet1 is blank. The end result of Sheet1 with all the raw data and then x number of tabs in the workbook with that template replicated and each row of data input into each tab.

Could I please get a hand with this? My google-fu fails, and I can't work out how to loop it.

This is all I have:

Sub create()
'
' create Macro
'
'
    Range("B1").Select
    Selection.Copy
    Sheets("FIC001").Select
    Range("C4:E4").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("C5:E5").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("B3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("H4:J4").Select
    ActiveSheet.Paste
    Range("C8:J8").Select
    Sheets("Sheet1").Select
    Range("A5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("I14:J14").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("C14:E14").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("C5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("H11:J11").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("C11:E11").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("E5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("F10").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("F5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("I10:J10").Select
    Sheets("Sheet1").Select
    ActiveWindow.SmallScroll Down:=-9
    Sheets("FIC001").Select
    Range("C10:D10").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("G5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("I10:J10").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("H5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("C7:E7").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("I5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("H7:J7").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("J5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("C15:E15").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("K5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("FIC001").Select
    Range("C8:J8").Select
    ActiveSheet.Paste
    Sheets("FIC001").Select
    ' Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("FIC001").Copy After:=Sheets(2)
 
 
End Sub

 

[AlphaFrog]

Sub create()
    
    Dim ws As Worksheet, Lastrow As Long, i As Long
    
    Set ws = Sheets("FIC001")   [COLOR="Green"]' Copy to worksheet[/COLOR]
    
    With Sheets("Sheet1")       [COLOR="Green"]' Copy from worksheet[/COLOR]
    
        [COLOR="Green"]' These cells are the same on each worksheet copy[/COLOR]
        .Range("B1").Copy ws.Range("C4:E4")
        .Range("B2").Copy ws.Range("C5:E5")
        .Range("B3").Copy ws.Range("H4:J4")
        
       [COLOR="Green"] ' These cells are copied from each row (row 5 to the last used row).[/COLOR]
        Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
        For i = 5 To Lastrow
            
            .Range("A" & i).Copy ws.Range("I14:J14")
            .Range("B" & i).Copy ws.Range("C14:E14")
            .Range("C" & i).Copy ws.Range("H11:J11")
            .Range("D" & i).Copy ws.Range("C11:E11")
            .Range("E" & i).Copy ws.Range("F10")
            .Range("F" & i).Copy ws.Range("I10:J10")
            .Range("F" & i).Copy ws.Range("C10:D10")
            .Range("G" & i).Copy ws.Range("I10:J10")
            .Range("H" & i).Copy ws.Range("C7:E7")
            .Range("I" & i).Copy ws.Range("H7:J7")
            .Range("J" & i).Copy ws.Range("C15:E15")
            .Range("K" & i).Copy ws.Range("C8:J8")
            
            ws.Copy After:=Sheets(Sheets.Count)
            
        Next i
        
    End With
    
End Sub

 

[repairman615]

Hello,

Welcome to the board!

I am a little gray on what exactly you are trying to do.

Would you break it down again. I will read again to see if I missed something. Mainly I am wondering if you would like this to create a new tab for each cell in column C:C resulting in many sheets. In other words, run the whole process again and again.

This type of structure may help in your coding:

<font face=Courier New>    Sheets("Sheet1").Range("B1").Copy Destination:=Sheets("FIC001").Range("C4:E4")</FONT>

This would be the first line.

 

[hamistasty]

Thanks AlphaFrog, you're amazing. Works brilliantly.

How would I best rename each tab as the corresponding row for cell C5, C6 etc. onwards (from Sheet1) as each tab is created?

repairman615:
I have a button on the first tab that uses raw data in the same tab to generate a tab template (copy and pasting the raw data into it) for each row of the raw data. The initial raw data tab is Sheet1, and then initial template tab that is being cloned is FIC001.

edit: you're a smart cookie AlphaFrog. I forgot to mention that the first 3 cells are repeated throughout. (ie. job name etc.)

 

[AlphaFrog]

How would I best rename each tab as the corresponding row for cell C5, C6 etc. onwards (from Sheet1) as each tab is created?

Add the line in red...

ws.Copy After:=Sheets(Sheets.Count)
[COLOR="Red"]Sheets(Sheets.Count).Name = .Range("C" & i).Value[/COLOR]

You're welcome. I'm glad it works for you.

 

[hamistasty]

Again, thank you. Just another quickie: That works great but it leaves FIC001 (the first template tab as it's original name but filled out with row 5.)

How could I edit it so that FIC001 is never used but is kept as a template unfilled? The whole thing starts by copying FIC001 & then conintuing on. So it'll look like: Sheet1 | FIC001 | 'generated tab1' | etc. etc.

 

[AlphaFrog]

Do you want to clear all the destination cells on sheet FIC001 after all the copies are made?

If yes, put this line just before End Sub

    ws.Range("C4:E4, C5:E5, H4:J4, I14:J14, C14:E14, H11:J11, C11:E11, F10, " & _
             "I10:J10, C10:D10, I10:J10, C7:E7, H7:J7, C15:E15, C8:J8").ClearContents

 

[hamistasty]

Thanks, it's all working great.

This macro goes to the tab name you search. How could I get it to search for the tab that has G11:J11 matching your search text? So I enter in 123 and it goes to the sheet with G11:J11 vaklue as 123.

Sub GoToSheet()
Dim Str As String
Dim Ans As String
Str = Application.InputBox("Enter Number", Type:=2)
On Error GoTo Trap
Sheets(Str).Select
End
Trap:
Ans = MsgBox(Prompt:="Do you want to try again?", _
            Buttons:=vbYesNo, Title:="Enter Number")
    If Ans = vbYes Then
            Call GoToSheet
                ElseIf Ans = vbNo Then
                End
            Else
            Exit Sub
    End If
End Sub

 

[AlphaFrog]

New question. This probably should be a new thread.

Sub GoToSheet()

    Dim strFindWhat As String
    Dim ws As Worksheet
    Dim rFound As Range
    Dim strMsg As String
    
    strMsg = "Enter number"
    
Retry:
    strFindWhat = Application.InputBox(strMsg, Title:="Search for Value", Type:=2)
    If strFindWhat = "False" Or strFindWhat = vbNullString Then Exit Sub  'User canceled
    
    For Each ws In Worksheets
    
        Set rFound = ws.Range("G11:J11").Find(strFindWhat, , xlValues, xlWhole, , xlNext, False)
        
        If Not rFound Is Nothing Then
            Application.Goto Reference:=rFound, Scroll:=False
            Exit For
        End If
    
    Next ws
        
    If rFound Is Nothing Then
        strMsg = "No match found for " & strFindWhat & vbCr & vbCr & "Enter new number.": GoTo Retry
        'If MsgBox("Do you want to try again?", vbYesNo, "No Match Found") = vbYes Then GoTo Retry
    End If
    
End Sub

 

[hamistasty]

Thanks, that works great as usual. I'll make a new thread for a new question next time, sorry.