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

sdgz747

New Member
Joined
Feb 2, 2021
Messages
9
Office Version
  1. 2016
Platform
  1. Windows
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: Master.JPG
    2. Import worksheet:Import.JPG
      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:

VBA Code:
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
 
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.
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
You can use an error trap to see if the sheet name exists and if it does then skip the copying.

VBA Code:
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
 
Upvote 0
this might be a better configuration of the code.

VBA 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
 
Upvote 0
this might be a better configuration of the code.

VBA 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.
 
Upvote 0
See if this will run.

VBA Code:
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
 
Upvote 0
Solution
See if this will run.

VBA Code:
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!
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top