Reformat spreadsheet's rows into columns

[Thalarcotos]

I need to reformat a spreadsheet to be compliant with another spreadsheet's formatting. I'd use TRANSPOSE but I need every row containing the same DEALER to be reformatted into columns:

DEALER DESC COUNT SALES
0018 Retail 14 $156,000
0018 Gas 15 $166,000
0018 Records 28 $15,000
0018 Sales 19 $980,000
0023 Retail 14 $156,000
0023 Gas 15 $166,000
0023 Records 28 $15,000
0023 Sales 19 $980,000


HOW I NEED FORMATTED
DLR DESC COUNT SALES DLR2 DESC2 COUNT2 SALES2 DLR3 DESC3 COUNT3 SALES3 DLR 4 DESC4 COUNT4 SALES4
0018 Retail 14 $156,000 0018 Gas 15 $166,000 0018 Gas 15 $166,000

SECOND ROW would contain next Dealer's information

There are approximately 650 dealers - there certainly has to be a better way than manual copy-paste, which is not feasible considering I have two spreadsheets that this needs to be done on and every quarter. I'm not versed in Macros, so any suggestions using such, I'd need step by step instructions.

Thank you for any suggestions.

[HansV]

Welcome to Eileen's Lounge!

You could use the following macro. It assumes that the table starts in cell A1. It will create a new sheet with the transposed data.

Code: Select all

Sub ConvertData()
  Dim wshSrc As Worksheet
  Dim wshTrg As Worksheet
  Dim s As Long
  Dim m As Long
  Dim t As Long
  Dim n As Long
  ' Suspend screen updating
  Application.ScreenUpdating = False
  ' Source sheet
  Set wshSrc = ActiveSheet
  ' Create target sheet
  Set wshTrg = Worksheets.Add
  ' Initialize t
  t = 1
  ' Last filled row
  m = wshSrc.Cells(wshSrc.Rows.Count, 1).End(xlUp).Row
  ' Loop through rows
  For s = 2 To m
    If wshSrc.Cells(s, 1) <> wshSrc.Cells(s - 1, 1) Then
      ' Move to next row in target sheet
      t = t + 1
      n = 0
    End If
    n = n + 1
    ' Column headings
    wshTrg.Cells(1, 4 * n - 3) = "DLR" & n
    wshTrg.Cells(1, 4 * n - 2) = "DESC" & n
    wshTrg.Cells(1, 4 * n - 1) = "COUNT" & n
    wshTrg.Cells(1, 4 * n) = "SALES" & n
    ' Values
    wshTrg.Cells(t, 4 * n - 3) = wshSrc.Cells(s, 1)
    wshTrg.Cells(t, 4 * n - 2) = wshSrc.Cells(s, 2)
    wshTrg.Cells(t, 4 * n - 1) = wshSrc.Cells(s, 3)
    wshTrg.Cells(t, 4 * n) = wshSrc.Cells(s, 4)
  Next s
  ' Update screen
  Application.ScreenUpdating = True
End Sub

[Thalarcotos]

Hans:

That's exactly what I needed.