I don't experience that problem with 6 and then 8 columns of sample data I used
in testing just now.

Copied Bob's code without the line-wrap and tested OK

Worked as advertised.

Perhaps you have some "merged cells" somewhere in your range(s) although in that
case you would get the "cannot change part of a merged cell" error message.

Have you tried using VBE Debug to step through and see where the error occurs?

Set up two windows side by side so you can see the worksheet as you step through
the code.


Gord



On Fri, 19 Jan 2007 12:24:35 -0800, excelmad
wrote:

Thank you Gord. I made it one liine and it is returning an error because the
copy area and paste areaare not the same size. Is there a way around this?

"Gord Dibben" wrote:

Bob's code got hit by "line wrap" when posted.

Those two lines are all one line.

..Cells(i, "B").Resize(1, iLastCol - 1).Copy .Cells(i - 1, cColumns + 1)


Gord Dibben MS Excel MVP

On Wed, 17 Jan 2007 13:49:02 -0800, excelmad
wrote:

Thanks Bob - However I am receiving an error on the following line:

.Cells(i, "B").Resize(1, iLastCol - 1).Copy .Cells(i - 1,
cColumns + 1)

Am I missing something?

"Bob Phillips" wrote:

This should take care of those issues and be number of columns independent

Public Sub ProcessData2()
Dim cColumns As Long
Dim i As Long
Dim iLastRow As Long
Dim iLastCol As Long
Dim cMaxCols As Long
Dim cell As Range
Dim sh As Worksheet

With ActiveSheet

cColumns = .Cells(1, .Columns.Count).End(xlToLeft).Column
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
iLastCol = .Cells(i, .Columns.Count) _
.End(xlToLeft).Column
.Cells(i, "B").Resize(1, iLastCol - 1).Copy .Cells(i - 1,
cColumns + 1)
If iLastCol + cColumns cMaxCols Then _
cMaxCols = iLastCol + cColumns - 1
.Rows(i).Delete
End If
Next i

'now add headings
For i = cColumns + 1 To cMaxCols Step cColumns - 1
.Range("B1").Resize(, cColumns - 1).Copy .Cells(1, i)
Next i

End With

End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"excelmad" wrote in message
...
Thank you Bob - this worked to some degree. The only issue is that It is
copying Column A and not repeating the column headers. Since column A
will
contain the unique record identifier I would like it to only reside in
column
A.

I also have another file I'd like to use this same Macro on which more
columns. How can I adjust this Macro to allow for columns beyond F?

Thank you for your help.

"Bob Phillips" wrote:

Public Sub ProcessData()
Dim i As Long
Dim iLastRow As Long
Dim cell As Range
Dim sh As Worksheet

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
.Cells(i, "A").Resize(1, .Cells(i, .Columns.Count) _
.End(xlToLeft).Column).Copy .Cells(i - 1, "G")
.Rows(i).Delete
End If
Next i

End With

End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"excelmad" wrote in message
...
I want the following Macro to copy information from column A:F based on
a
repeat reference in column A, paste data beginning in the column G, Add
a
sheet, paste in new sheet, go back to Sheet1 and delete A:F. All is
working
fine except the Macro is only copying the information in columns A and
B.

What do I need to do to get my desired result?

SAMPLE DATA
Column A Column B Column C Column D Column E Column F
111-11-1111 John Andrews Chicago CS Tech
111-11-1111 Daniel Edwards Philadelphia IT Mgr
222-22-2222 Elias Martin Charlotte IT Sup
333-33-3333 Augusta Clemens Philadelphia CS Tech
333-33-3333 Jaime Turner Boston IT Sup
333-33-3333 Wayne Norriston Atlanta DR Dir
RESULT I RECEIVE WITH THE MACRO BELOW:
Column A Column B Column C Column D Column E Column F
111-11-1111 John Daniel
222-22-2222 Elias
333-33-3333 Augusta Jaime Wayne CS Tech
RESULT I WANT:
Column A Column B Column C Column D Column E Column F Column G Column
H Column I Column J Column K Column L Column M Column N Column O Column
P
111-11-1111 John Andrews Chicago CS Tech Daniel Edwards Philadelphia IT
Mgr
222-22-2222 Elias Martin Charlotte IT Sup
333-33-3333 Augusta Clemens Philadelphia CS Tech Jaime Turner Boston IT
Sup Wayne Norriston Atlanta DR Dir

Sub ReArrange()
Dim FirstCell As Range
Dim LastCell As Range
Dim Dest As Range
Dim c As Long
Set FirstCell = Range("A1")
Do Until FirstCell.Value = ""
For c = 1 To 20
If FirstCell.Offset(c).Value < FirstCell.Value Then
Set LastCell = FirstCell.Offset(c - 1)
Set Dest = Range("G" & Rows.Count).End(xlUp).Offset(1)
Exit For
End If
Next c
Dest.Value = FirstCell.Value
For c = 1 To Range(FirstCell, LastCell).Count
Dest.Offset(, c).Value = FirstCell.Offset(c - 1, 1).Value
Next c
Set FirstCell = LastCell.Offset(1)
Loop
Columns("A:F").Select
Columns("A:F").Copy
Sheets.Add
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Columns("A:F").Delete
MsgBox "Run Complete"
End Sub