Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,298
Default Copying data from Sheet1 which is on multiple rows for each custo

4 issues.
1 - your DIM was wrong - missing 'AS'
2 - you need to SET an worksheet object to a sheet
3 - offseting a row down a sheet isn't -1. the row number increases...
4 - when yuo copied a row, you moved your sourcde to the next row, it should
be three rows down:


Option Explicit
Sub CustListl()
Dim WS As Object
Dim LastRow As Long
Dim R1 As Long ' ***
R1 = 2
Set 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(3, 0).Select '***
Loop Until ActiveCell.Row LastRow
Application.ScreenUpdating = True
End Sub

Option Explicit

Sub CustListl()
Dim WS As Object
Dim LastRow As Long
Dim R1 As Long ' ***
R1 = 2
Set 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(3, 0).Select
Loop Until ActiveCell.Row LastRow
Application.ScreenUpdating = True
End Sub





"u473" wrote:

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

.

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 184
Default Copying data from Sheet1 which is on multiple rows for each custo

Thanks a lot, it works fine.
Could I ask you to show me the changes /additions
if I am calling the execution from the Destination worksheet
and the Source worksheet is in a separate closed workbook ?
That may be basics but I have to understand that minimum sequence
of code.
Thanks again
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy data from sheet2 to sheet1 when sheet2 has variable # of rows Anne Excel Discussion (Misc queries) 6 February 27th 09 09:48 PM
Copying Sheet1 to Sheet2 in a certain pattern BEE Excel Programming 6 December 10th 08 08:34 AM
A1 Sheet2 is linked to A1 sheet1 so that user enters value(abc123) a1 sheet1 and A1 sheet2 is updated pano[_3_] Excel Programming 2 October 28th 07 02:32 PM
copying data from sheet1 to sheet2 Rookie Excel Worksheet Functions 3 September 7th 06 12:09 PM
Copying records from sheet1 to sheet2?? j2dizzo Excel Programming 7 December 6th 05 03:29 PM


All times are GMT +1. The time now is 12:27 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"