View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
u473 u473 is offline
external usenet poster
 
Posts: 184
Default Copying data from Sheet1 which is on multiple rows for each customerto Sheet2 on single row.

I have Customers data in the following format in Sheet(1) :
Col. A Col. B
Cust1 Name Cust1 Phone
Cust1 Address Cust1 Cell
Cust1 City Cust1 Email
Cust2 Name Cus2 Phone
Cust2 Address Cust2 Cell
Cus2 City Cust2 Email
Etc...
How do I export on Sheet(2) each customer data on a single line like :
Col. A Col.B Col. C Col.
D Col. E Col. F
Cust1 Name Cust1 Address Cust1 City Cust1 Phone Cust1 Cell
Cust1 Email
Cust2 Name Cust2 Address Cust2 City Cust2 Phone Cust2 Cell
Cust2 Email

Where did I go wrong with the following code ? Help appreciated

Sub CustListl()
Dim WS As Object
Dim LastRow Long
Dim R1 As Long ' Destination WorkSheet Start Row
R1 = 2
WS = ThisWorkbook.Sheets(2)
Application.ScreenUpdating = False
On Error Resume Next
Sheets(1).Activate
LastRow = Range("A65000").End(xlUp).Row
Range("A1").Select
Do
WS.Cells(R1, 1).Value = ActiveCell.Offset(0, 0) ' Name
WS.Cells(R1, 2).Value = ActiveCell.Offset(-1, 0) ' Address
WS.Cells(R1, 3).Value = ActiveCell.Offset(-2, 0) ' City
WS.Cells(R1,4).Value = ActiveCell.Offset(0, 1) ' Phone
WS.Cells(R1, 5).Value = ActiveCell.Offset(-1, 1) ' Cell
WS.Cells(R1, 6).Value = ActiveCell.Offset(-2, 1) ' City
R1 = R1 + 1
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Row LastRow
Application.ScreenUpdating = True
End Sub