Auto Populating new sheets

[Big_Cat]

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 Item	Spec Section	Work Item	Manufacturer	Product Description	Date Submitted	Date Approved	Days Outstanding	Comments
1	1a	02 74 10	Hot Mix Asphalt		Asphalt Mix Design	5/21/15
2	2a	03 13 00	Ready Mix Design		Concrete Ready mix	5/21/15
3	2b	03 13 00	Daravair		Air Entrainment admixture	5/21/15
4		05 31 00	Metal Decking	Vulcraft	1.5VLR	5/21/15			Engineer to choose style

<tbody>
</tbody>

Sheet 2

Product No:	1
Sub Product No:
Spec Section	02 74 10
Product Name	Hot Mix Asphalt
Manufacturer
Product Description	Asphalt Mix Design
Date Submitted	5/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]

Here is a macro that will do just that. Take a look.

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