Excel VBA - Loop Through Worksheet, Copy Cells, Paste into New Worksheet

[sdgz747]

Hello, I am new to VBA and my knowledge is limited. I will try my best to provide an accurate description, but if additional clarification is needed please reach out. I am trying to create a VBA to accomplish the following:

1. I need to replicate a Master worksheet based on the number of rows from an Import worksheet
   1. Master worksheet:
      
   2. Import worksheet:
      1. In the example above, I would expect to see 4 new worksheets be created. Additionally, with the code I have so far, the new tabs will be named 1, 2, 3, and 4
2. I also need to fill in the cells in the created worksheets with the associated data pulled in from the Import worksheet row
   1. I believe I need some sort of loop to pull in data from each row from the Import worksheet until I reach the end of the worksheet
   2. Identified rows from the Import worksheet I need to copy are (keep in mind, I need to start from row 2 then proceed until there are no more rows with data):
      1. A, B, O, Q, Y, BG, BW, CB, CC, CD, CE, CH, CJ
   3. Identified rows I need to paste in the newly created worksheets are (the rows will always be the same, but the worksheet will always be new):
      1. B7:C8, E7:F8, I7:J8, C14:E14, C15:E15, C16:E16, H14:J14, H16:J16, E20:J21, E22:J22, E23:J23, A27:J33, A37:J43
3. This may be overkill, but is there some kind of check I can run to ensure duplicates do not occur?

The code I have so far replicates the Master worksheet until there is no more data in the Import worksheet. In the example I've given, 4 new worksheets will be created using the Master worksheet template and the worksheet names will be 1, 2, 3, and 4. I have not yet been able to figure out the looping required to pull in data. The code is as follows:

Sub makeTPRs()

' Declare variables sh1, sh2, c
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim c As Range

' Set sh1 to TPR_Master worksheet
Set sh1 = Sheets("TPR_Master")
' Set sh2 to Jira_Import worksheet
Set sh2 = Sheets("Jira_Import")

' Count each number of filled rows in column 2, for every row counted create a new worksheet
' based on the TPR_Master worksheet and give the tab the associated TPR value
    For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
        sh1.Copy Before:=sh1
        ActiveSheet.Name = c.Value
    Next

End Sub

 

[sdgz747]

In the case I were to pull in a new import, is there a way to check if there is an existing worksheet and skip it instead of the code throwing an error?

The other thought I had was to create pdf's of the document (I have code to do that), then once everything has printed out, clear up the Excel spreadsheet.

 

[JLGWhiz]

You can use an error trap to see if the sheet name exists and if it does then skip the copying.

On Error Resume Next    
        For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
             If IsError(Sheets(c.Value)) Then
                 sh1.Copy Before:=sh1
                 ActiveSheet.Name = c.Value
            End If
        Next    
On Error GoTo 0
Err.Clear

 

[JLGWhiz]

this might be a better configuration of the code.

For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
         On Error Resume Next
            If IsError(Sheets(c.Value)) Then
                sh1.Copy Before:=sh1
                ActiveSheet.Name = c.Value
                On Error GoTo 0
                Err.Clear
            End If
    Next

 

[sdgz747]

this might be a better configuration of the code.

For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
         On Error Resume Next
            If IsError(Sheets(c.Value)) Then
                sh1.Copy Before:=sh1
                ActiveSheet.Name = c.Value
                On Error GoTo 0
                Err.Clear
            End If
    Next

Thank you! I've been trying to fit this into the code, but I keep running into errors. The closest success I have had so far is to get new tabs to generate, but no data is populating. I'm pretty sure I'm pasting this into the code in the wrong place.

 

[JLGWhiz]

See if this will run.

Sub t3()
Dim ary1 As Variant
Dim ary2 As Variant
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim c As Range
Dim i As Long
ary1 = Array("A", "B", "BW", "CB", "Q", "Q", "BG", "O", "CC", "CH", "CE", "CJ", "Y", "CD")
ary2 = Array("C6", "C7", "C8", "C9", "C12", "C13", "C14", "H12", "H14", "C17", "C18", "C19", "A22", "A31")
clrrng = ("C6:J9, C12:E14, H12:J12, H14:J14, C17:J19, A22:J28, A31:J37")
Set sh1 = Sheets("TPR_Master")
Set sh2 = Sheets("Jira_Import")
    For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
        If c <> "" Then
            On Error Resume Next
            If IsError(Sheets(c.Value)) Then
                For i = LBound(ary1) To UBound(ary1)
                    sh1.Range(ary2(i)) = sh2.Cells(c.Row, ary1(i)).Value
                Next
                sh1.Copy After:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = c.Value
                On Error GoTo 0
                Err.Clear
            End If
        End If
    Next
sh1.Range(clrrng).ClearContents
End Sub

 

[sdgz747]

See if this will run.

Sub t3()
Dim ary1 As Variant
Dim ary2 As Variant
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim c As Range
Dim i As Long
ary1 = Array("A", "B", "BW", "CB", "Q", "Q", "BG", "O", "CC", "CH", "CE", "CJ", "Y", "CD")
ary2 = Array("C6", "C7", "C8", "C9", "C12", "C13", "C14", "H12", "H14", "C17", "C18", "C19", "A22", "A31")
clrrng = ("C6:J9, C12:E14, H12:J12, H14:J14, C17:J19, A22:J28, A31:J37")
Set sh1 = Sheets("TPR_Master")
Set sh2 = Sheets("Jira_Import")
    For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
        If c <> "" Then
            On Error Resume Next
            If IsError(Sheets(c.Value)) Then
                For i = LBound(ary1) To UBound(ary1)
                    sh1.Range(ary2(i)) = sh2.Cells(c.Row, ary1(i)).Value
                Next
                sh1.Copy After:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = c.Value
                On Error GoTo 0
                Err.Clear
            End If
        End If
    Next
sh1.Range(clrrng).ClearContents
End Sub

Thank you for your help, this worked out great for what I was looking to do!

 

[JLGWhiz]

Thank you for your help, this worked out great for what I was looking to do!

You're welcome,
Regards, JLG