Create worksheets and transpose range from the master worksheet

[LuigiCortisone]

Hi, I'm looking for vba that will cycle down through column A in the 'master' worksheet and create a worksheet from each row using the value in colA as the sheet name

Then as each worksheet is created to copy and transpose a range (cols D to G) from the row in the master sheet to the first two columns in the new worksheet.

ColA in the new worksheet is the row headings from the master sheet and ColB is the transposed row from the master sheet

Cheers, Luigi

 

[My Aswer Is This]

Trying to help.
You said:
Then as each worksheet is created to copy and transpose a range (cols D to G) from the row in the master sheet to the first two columns in the new worksheet.

D To G is four cell values. Ho do we put that into the first two columns. We would need four columns

And then you said:
ColA in the new worksheet is the row headings from the master sheet and ColB is the transposed row from the master sheet

I'm confused.

 

[My Aswer Is This]

Now that I see it more to transpose it, we would only need one column not two.

 

[Fluff]

How about

Sub LuigiCortisone()
   Dim Cl As Range
   Dim Hdr As Variant
   
   With Sheets("Master")
      Hdr = Range("A1:G1").Value2
      For Each Cl In .Range("A2", .Range("A" & rows.Count).End(xlUp))
         If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
            With Sheets(Cl.Value)
               .Range("A1:A4").Value = Application.Transpose(Hdr)
               .Range("B1:B4").Value = Application.Transpose(Cl.Offset(, 3).Resize(, 4).Value)
            End With
         End If
      Next Cl
   End With
End Sub

 

[LuigiCortisone]

How about

Sub LuigiCortisone()
   Dim Cl As Range
   Dim Hdr As Variant
  
   With Sheets("Master")
      Hdr = Range("A1:G1").Value2
      For Each Cl In .Range("A2", .Range("A" & rows.Count).End(xlUp))
         If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
            With Sheets(Cl.Value)
               .Range("A1:A4").Value = Application.Transpose(Hdr)
               .Range("B1:B4").Value = Application.Transpose(Cl.Offset(, 3).Resize(, 4).Value)
            End With
         End If
      Next Cl
   End With
End Sub

Gracie Mille, this is close but not quite there. I have attached pics of the master worksheet and two transposed worksheets after the code has run

For each record in the master worksheet the code creates a new worksheet with the value in colA as the worksheet name

The first row in the master worksheet contains the headings which are transposed into colA of each worksheet
Each worksheet gets populated by the row (colA to colC) of the master where the location in colA matches the worksheet name. Transposed values go into colB

I'm fairly new to this so help is appreciated

Cheers, Luigi

 

[Fluff]

You said the code should transpose the values in D:G, which it does, but our image looks as though you want it to transpose the values in A:E instead.
Have you made any changes to the code I posted, if so please post the code you are using.

 

[LuigiCortisone]

Sorry, I tried to make it clearer with the images and made a few changes to the original spreadsheet

I just want to transpose the first 4 columns (A:D). Excluding colE

Here is the code I've got...

Sub AddMultipleSheet2()

Dim sheets_count As Integer
Dim sheet_name As String
Dim i As Integer

Dim Cl As Range
Dim Hdr As Variant

sheet_count = Range("A2:A4").Rows.Count

For i = 1 To sheet_count

    sheet_name = Sheets("test").Range("A2:A4").Cells(i, 1).Value
    
    If SheetCheck(sheet_name) = False And sheet_name <> "" Then
    Worksheets.Add().Name = sheet_name
  
   With Sheets("master")
      Hdr = Range("A1:D1").Value2
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
            With Sheets(Cl.Value)
               .Range("A1:A4").Value = Application.Transpose(Hdr)
               .Range("B1:B4").Value = Application.Transpose(Cl.Offset(, 3).Resize(, 4).Value)
            End With
         End If
      Next Cl
   End With
    
    
    End If

Next i

End Sub

Function SheetCheck(sheet_name As String) As Boolean

Dim ws As Worksheet

SheetCheck = False 
For Each ws In ThisWorkbook.Worksheets 
    If ws.Name = sheet_name Then    
        SheetCheck = True        
    End If 
Next 
End Function

 

[Fluff]

Ok, if you want columns A:D try

Sub LuigiCortisone()
   Dim Cl As Range
   Dim Hdr As Variant
   
   With Sheets("Master")
      Hdr = .Range("A1:D1").Value2
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
            With Sheets(Cl.Value)
               .Range("A1:A4").Value = Application.Transpose(Hdr)
               .Range("B1:B4").Value = Application.Transpose(Cl.Resize(, 4).Value)
            End With
         End If
      Next Cl
   End With
End Sub

 

[LuigiCortisone]

Ok, if you want columns A:D try

Sub LuigiCortisone()
   Dim Cl As Range
   Dim Hdr As Variant
  
   With Sheets("Master")
      Hdr = .Range("A1:D1").Value2
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
            With Sheets(Cl.Value)
               .Range("A1:A4").Value = Application.Transpose(Hdr)
               .Range("B1:B4").Value = Application.Transpose(Cl.Resize(, 4).Value)
            End With
         End If
      Next Cl
   End With
End Sub

Fantastico! Grazie molto

 

[Fluff]

You're welcome & thanks for the feedback.