Sub Group

[Buddy]

Option Explicit

Sub Group()

Dim rFind As Range, sAddress As String, rng As Range, c As Long, n As Long,
r As Long

c = 3: r = 1
Sheets("Sheet2").UsedRange.Clear
With Sheets("Sheet1")
For Each rng In .Range("A1", .Range("A1").End(xlDown))
Sheets("Sheet2").Cells(r, 1).Resize(, 2).Value = rng.Resize(, 2).Value
n = Sheets("Sheet2").Cells.Find(What:="*", LookAt:=xlWhole,
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Do While c < 20
r = n
With .Columns(c)
Set rFind = .Find(What:=rng, LookIn:=xlFormulas,
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False)
If Not rFind Is Nothing Then
sAddress = rFind.Address
Do
If c < 13 Then
Sheets("Sheet2").Cells(r, c).Resize(, 2).Value =
rFind.Resize(, 2).Value
Else
Sheets("Sheet2").Cells(r, c).Resize(, 3).Value =
rFind.Resize(, 3).Value
End If
r = r + 1
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> sAddress
End If
End With
If c < 13 Then
c = c + 2
Else
c = c + 3
End If
Loop
c = 3
r = Sheets("Sheet2").Cells.Find(What:="*", LookAt:=xlWhole,
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Next rng
End With

End Sub

Right now this code

1. Goes to “Sheet1†and looks at the contents in Column A then looks for a
duplicate of those contents in Column C, Column E, Column G, Column I, Column
K, Column M, Column P, and Column S.

2. When Column A has duplicates in
Column C
Column E
Column G
Column I
Column K
Column M
Column P
Column S

This macro copies that row of..
Columns A plus Column B
Columns C plus Column D
Columns E plus Column F
Columns G plus Column H
Columns I plus Column J
Columns K plus Column L
Columns M plus Column N and Column O
Columns P plus Column Q and Column R
Columns S plus Column T and Column U

Goes to Sheet2 and pastes those different rows into the same row, so
Column A:B
Column C
Column E:F
Column G:H
Column I:J
Column K:L
Column M:O
Column Q:R
Column T:U
are all in the same row

I am looking for help so the macro will do this instead.

In Sheet1 when Column A has duplicates in
Column C
Column F
Column I

I would like to copy that row of..
Column A plus Column B
Column C plus Column D and Column E
Column F plus Column G and Column H
Column I plus Column J, Column K, and Column L

3. Then Go to Sheet2 paste those different rows into the same row, so
Column A:B
Column C:E
Column F:H
Column I:L
Would all be in the same row

Thank you for your help.