Transpose Grouped Data

[BoyMom826]

I have be given the below data set. We have 67 rows with four sets of golfer information in each row. I am needing to make it so I only have one golfer/row. I don't know why I'm having so much trouble figuring this out, but I think i've been staring at it too long to have a logical approach. Any assistance would be wonderful!

COMPANY

GOLFER 1

GOLFER 1 CELL PHONE

GOLFER 1 EMAIL

GOLFER 2

GOLFER 2 CELL PHONE

GOLFER 2 EMAIL

GOLFER 3

GOLFER 3 CELL PHONE

GOLFER 3 EMAIL

GOLFER 4

GOLFER 4 CELL PHONE

GOLFER 4 EMAIL

 

[DanteAmor]

It is not clear to me how your data is and what the result will be like.
You could use XL2BB tool minisheets, to put the how it is and the how it should be.

 

[BoyMom826]

@DanteAmor I apologize for missing this before!!

Here is currently how it is listed. The problem is that I need each individual golfer's information in an uploadable format.

2021 EMGC Golfer Info.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	COMPANY	GOLFER 1	GOLFER 1 CELL PHONE	GOLFER 1 EMAIL	GOLFER 2	GOLFER 2 CELL PHONE	GOLFER 2 EMAIL	GOLFER 3	GOLFER 3 CELL PHONE	GOLFER 3 EMAIL	GOLFER 4	GOLFER 4 CELL PHONE	GOLFER 4 EMAIL
2	Company 1	Company 1's 1st Golfer			Company 1's 2nd Golfer			Company 1's 3rd Golfer			Company 1's 4th Golfer
3	Company 2	Company 2's 1st Golfer			Company 2's 2nd Golfer			Company 2's 3rd Golfer			Company 2's 4th Golfer
4	Company 3	Company 3's 1st Golfer			Company 3's 2nd Golfer			Company 3's 3rd Golfer			Company 3s' 4th Golfer
Sheet2

So instead of Company 1's name with all four golfers listed in the following columns, I would prefer 4 rows of Company 1 each with 1 golfer's name, phone, and email address. Like this:

2021 EMGC Golfer Info.xlsx
	A	B	C	D
1	COMPANY	GOLFER 1	GOLFER 1 CELL PHONE	GOLFER 1 EMAIL
2	Company 1	Company 1's 1st Golfer
3	Company 1	Company 1's 2nd Golfer
4	Company 1	Company 1's 3rd Golfer
5	Company 1	Company 1's 4th Golfer
6	Company 2	Company 2's 1st Golfer
7	Company 2	Company 2's 2nd Golfer
8	Company 2	Company 2's 3rd Golfer
9	Company 2	Company 2's 4th Golfer
Sheet3

 

[Fluff]

How about

Sub BoyMom()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   With Sheets("Sheet2")
      Ary = .Range("A2:M" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary) * 4, 1 To 4)
   
   For r = 1 To UBound(Ary)
      For c = 2 To UBound(Ary, 2) Step 3
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
         Nary(nr, 2) = Ary(r, c)
         Nary(nr, 3) = Ary(r, c + 1)
         Nary(nr, 4) = Ary(r, c + 2)
      Next c
   Next r
   With Sheets("Sheet3")
      Sheets("Sheet2").Range("A1:D1").Copy .Range("A1")
      .Range("A2").Resize(nr, 4).Value = Nary
   End With
End Sub

 

[alansidman]

An alternative solution is to use Power Query to Unpivot your data

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"COMPANY", type text}, {"GOLFER 1", type text}, {"GOLFER 1 CELL PHONE", type any}, {"GOLFER 1 EMAIL", type any}, {"GOLFER 2", type text}, {"GOLFER 2 CELL PHONE", type any}, {"GOLFER 2 EMAIL", type any}, {"GOLFER 3", type text}, {"GOLFER 3 CELL PHONE", type any}, {"GOLFER 3 EMAIL", type any}, {"GOLFER 4", type text}, {"GOLFER 4 CELL PHONE", type any}, {"GOLFER 4 EMAIL", type any}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"COMPANY"}, "Attribute", "Value")
in
    #"Unpivoted Other Columns"

 

[BoyMom826]

How about

Sub BoyMom()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   With Sheets("Sheet2")
      Ary = .Range("A2:M" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary) * 4, 1 To 4)
  
   For r = 1 To UBound(Ary)
      For c = 2 To UBound(Ary, 2) Step 3
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
         Nary(nr, 2) = Ary(r, c)
         Nary(nr, 3) = Ary(r, c + 1)
         Nary(nr, 4) = Ary(r, c + 2)
      Next c
   Next r
   With Sheets("Sheet3")
      Sheets("Sheet2").Range("A1:D1").Copy .Range("A1")
      .Range("A2").Resize(nr, 4).Value = Nary
   End With
End Sub

Thanks so much! This worked PERFECTLY!

 

[Fluff]

Glad we could help & thanks for the feedback.