merge two data sheets into one

[nicko]

Hi all,

I have a manual process I have to do every month and I want to try and automate the procedure.

I have attached an example to make it easier to explain.

I have two tables of data both in the same format (sheet 1 and sheet 2) with names down the left, Sites across the top, and values in the cells under the respective headings.

Is it possible to create a macro that will merge the two tables into one, like I have done in sheet 3? so i have all sites across the top, all suppliers in one column down th left and all values copied across.

I dont even know where to start on this, so if anyone has any ideas it would be much appreciated.

Thanks,

Nicko

[mdmackillop]

Can names be repeated on both source sheets?

[nicko]

hi there
names can be repeated on both source sheets, as long as it doesnt repeat the values in the master sheet.

many thanks,

[mdmackillop]

Very fiddly. I'm sure there is a better methodology

Option Explicit

Sub Macro1()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet

Dim rng2c As Range
Dim rng2r As Range
Dim rng3c As Range
Dim rng3r As Range

Dim r As Range, c As Range, cel As Range, tgt As Range
Dim Rw As Long, Col As Long
Dim Nm As String, Site As String

Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
Set sh3 = Sheets.Add

Set rng2c = Intersect(sh2.Columns(3), sh2.UsedRange)
Set rng2r = Intersect(sh2.Rows(2), sh2.UsedRange)
Set rng3c = sh3.Columns(3)
Set rng3r = sh3.Rows(2)

sh1.Cells.Copy sh3.Range("A1")
sh3.Activate

'Add names
For Each cel In rng2c
Set tgt = sh3.Cells(Rows.Count, 3).End(xlUp).Offset(1)
If rng3c.Find(cel, lookat:=xlWhole) Is Nothing Then
cel.Copy tgt
End If
Next
'Add locations
For Each cel In rng2r
Set tgt = sh3.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
If rng3r.Find(cel, lookat:=xlWhole) Is Nothing Then
cel.Copy tgt
End If
Next

Rw = sh3.Cells(Rows.Count, 3).End(xlUp).Row
Col = sh3.Cells(2, Columns.Count).End(xlToLeft).Column

With sh3
For Each cel In Range(.Cells(4, 5), .Cells(Rw, Col))
Nm = sh3.Cells(cel.Row, 3)
Site = sh3.Cells(2, cel.Column)
Set r = rng2c.Find(Nm, lookat:=xlWhole)
Set c = rng2r.Find(Site, lookat:=xlWhole)
If Not r Is Nothing And Not c Is Nothing Then
cel.Value = cel.Value + sh2.Cells(r.Row, c.Column)
If cel.Value = 0 Then cel.Value = ""
End If
Next
End With
End Sub

[nicko]

this is brilliant.

Where a name is on both sheets is it possible to have the name appear both times with its respective value lsited in the new sheet, instead of a unique entry in the new sheet where the values are added together?

Many thanks,

Nicko