Combining two list of data

A

Andy in Edinburgh

Hi

I have 2 worksheets, on the 1st is a list customers and on the 2nd is a list
of companies that the customers belong to.

I'd like to combine the lists into one so that the company appears at the
top and the customers underneath. If also possible I'd like to put a page
break in so one company appears on each printed page.

See example info below.

Sheet 1
Comp ID Address1 Address2 Address3 Post Code Company Amount Due
33560 PO Box 12 Bulwer Ave Berks BG1 2TY Towry £120
50560 PO Box 11 Sandy Lane Sussex J20 7YU Skipton £110

Sheet 2
Comp ID Address1 Address2 Address3 Post Code Name Amt Owed

33560 1 Tall Lane Lurgan Harts WR1 2BH Mr J Smith £60
33560 41 Irish Rd Mile Cross Cambs IR4 8UJ Mr I Cole £60
50560 1 Brae Ave Drumbo Pinner DM4 1KL Mr K Loch £50
50560 7 Allyn Rd Camberly Surrey GH7 8JL Mr H Jones £60

Thanks in advance

Andy
 
J

Jarek Kujawa

select yr Comp ID's 1st column in Sheet1 and try the following macro:

Sub polacz_listy()
For Each cell In Selection
For i = 2 To 20000
If Sheets("Arkusz2").Cells(i, 1) = cell Then
Sheets("Arkusz2").Cells(i, 1).Rows.EntireRow.Copy
Sheets("Arkusz3").Cells(licznik + i, 1) = cell
Sheets("Arkusz3").Cells(licznik + i + 1, 1).PasteSpecial
Paste:=xlValues
'Sheets("Arkusz3").Rows(i).EntireRow =
Sheets("Arkusz1").Rows(cell.Row).EntireRow
licznik = licznik + 1
End If
Next i
Next cell
End Sub

the result will be in Sheet3 so make sure it is in place before you
start the macro
adjust the figure "20000" in the loop to yr needs, macro runs till row
number 20000

HIH
 
J

Jarek Kujawa

here is a better version, sorry for previous


Sub polacz_listy()
Dim Cell as Range
Dim i as Integer
Dim licznik as Integer 'counter

Sheets("Sheet3").Cells.ClearContents

Sheets("Sheet1").Select
Range(Cells(2, 1), Cells(20000, 1)).Select


For Each Cell In Selection

For i = 2 To 20000
If Len(Cell) > 0 And Sheets("Sheet2").Cells(i, 1) = Cell Then

Sheets("Sheet1").Rows(Cell.Row).EntireRow.Copy
Sheets("Sheet3").Cells(licznik + i, 1).PasteSpecial
Paste:=xlValues

Sheets("Sheet2").Cells(i, 1).Rows.EntireRow.Copy
Sheets("Sheet3").Cells(licznik + i + 1, 1).PasteSpecial
Paste:=xlValues

licznik = licznik + 1

End If
Next i

Next Cell

Sheets("Sheet3").Activate

Application.CutCopyMode = False

End Sub
 
J

Jarek Kujawa

with pagebreak


Sub polacz_listy()
Dim cell As Range
Dim i As Integer
Dim licznik As Integer
Dim company As String

Sheets("Sheet3").Cells.ClearContents

Sheets("Sheet1").Activate
Range(Cells(2, 1), Cells(20000, 1)).Select


For Each cell In Selection


For i = 2 To 20000
If Len(cell) > 0 And Sheets("Sheet2").Cells(i, 1) = cell Then

If Len(company) > 0 And company <> cell Then
Sheets("Sheet3").HPageBreaks.Add
Before:=Sheets("Sheet3").Cells(licznik + i, 1)
End If

company = cell

Sheets("Sheet1").Rows(cell.Row).EntireRow.Copy
Sheets("Sheet3").Cells(licznik + i, 1).PasteSpecial
Paste:=xlValues

Sheets("Sheet2").Cells(i, 1).Rows.EntireRow.Copy
Sheets("Sheet3").Cells(licznik + i + 1, 1).PasteSpecial
Paste:=xlValues

licznik = licznik + 1

ElseIf Len(cell) = 0 Then

Exit For

End If
Next i

Next cell

Sheets("Sheet3").Activate

Application.CutCopyMode = False

End Sub
 
Top