Auto Populating new sheets

Big_Cat

New Member
Joined
May 21, 2015
Messages
1
I'm trying to figure out how to populate Sheet 2 (Item 1) with the information from Sheet 1 (Submittals log) Row 6 automatically. I'd like a new sheet created for each item in Column A with the same format as the Sheet 2, but with the information for the next Row down (Item 2) and I'd like the sheet to take the name of the "Work Item" (Column D).

Item NO:Sub ItemSpec SectionWork ItemManufacturerProduct DescriptionDate SubmittedDate ApprovedDays OutstandingComments
11a02 74 10Hot Mix AsphaltAsphalt Mix Design5/21/15
22a03 13 00Ready Mix DesignConcrete Ready mix5/21/15
32b03 13 00DaravairAir Entrainment admixture5/21/15
405 31 00Metal DeckingVulcraft1.5VLR5/21/15Engineer to choose style

<tbody>
</tbody>

Sheet 2
Product No:1
Sub Product No:
Spec Section02 74 10
Product NameHot Mix Asphalt
Manufacturer
Product DescriptionAsphalt Mix Design
Date Submitted5/21/2015
Approval
Comments

<tbody>
</tbody>

Sheet 3 would auto populate with information from Row 3 "Item 2"

Any ideas, I know basic excel, but not enough to figure this out myself.
 

iliace

Well-known Member
Joined
Jan 15, 2008
Messages
3,531
Here is a macro that will do just that. Take a look.

Rich (BB code):
Option Explicit


Public Sub PopulateNewSheets()
  ' name of the source sheet
  Const sSOURCE_SHEET As String = "Sheet 1"
  
  ' to determine the entire range
  Dim rngTopLeft As Excel.Range
  Dim rngBottomLeft As Excel.Range
  Dim rngTopRight As Excel.Range
  
  ' to select entire source range as well as header column
  Dim rngSource As Excel.Range
  Dim rngSourceHeader As Excel.Range
  
  ' to select each individual row
  Dim rngSourceRecord As Excel.Range
  
  ' object variables to manipulate the sheets
  Dim wshSource As Excel.Worksheet
  Dim wshDest As Excel.Worksheet
  
  ' temporary helper variables
  Dim sName As String
  Dim i As Long
  Dim bContinue As Boolean
  
  ' set source sheet
  Set wshSource = ThisWorkbook.Worksheets(sSOURCE_SHEET)
  
  ' define the dimensions of the source
  Set rngTopLeft = wshSource.Range("A1")
  Set rngBottomLeft = rngTopLeft.End(xlDown)
  Set rngTopRight = rngTopLeft.End(xlToRight)
  
  Set rngSource = wshSource.Range(rngTopLeft, Intersect(rngBottomLeft.EntireRow, rngTopRight.EntireColumn))
  Set rngSourceHeader = wshSource.Range(rngTopLeft, rngTopRight)
  
  ' loop through each row of data
  ' create a new sheet
  ' if one already exists, replace it
  For i = 2 To rngSource.Rows.Count
    Set rngSourceRecord = rngSource.Rows(i)
    sName = rngSourceRecord.Cells(1, 4).Value
    On Error Resume Next
      Set wshDest = ThisWorkbook.Worksheets(sName)
    On Error GoTo 0
    If wshDest Is Nothing Then
      Set wshDest = ThisWorkbook.Worksheets.Add
      On Error Resume Next
        wshDest.Name = sName
        bContinue = True
        If Err.Number <> 0 Then
          bContinue = False
          Call MsgBox("Work Item " & sName & " is not a valid worksheet name")
        End If
      On Error GoTo 0
      
    Else
      bContinue = True
      wshDest.Cells.Clear
    End If
    
    If bContinue Then
      rngSourceHeader.Copy
      wshDest.Cells(1, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True


      rngSourceRecord.Copy
      wshDest.Cells(1, 2).PasteSpecial Paste:=xlPasteAll, Transpose:=True
      
      wshDest.UsedRange.EntireColumn.AutoFit
    End If
    bContinue = False
    Set wshDest = Nothing
  Next i
  
  Application.CutCopyMode = False
  
End Sub
 

Forum statistics

Threads
1,082,585
Messages
5,366,466
Members
400,892
Latest member
lamarh755

Some videos you may like

This Week's Hot Topics

Top