Hi,

Try this:

Sub Reorganise()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws2rng As Range
Dim lastrow As Long, r As Long, c As Integer, lastcol As Integer

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")

Set ws2rng = ws2.Range("a2")
ws2rng.Offset(-1, 0).Resize(1, 3) = Array("Location", "Company Name",
"Product")

With ws1
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lastrow
lastcol = .Cells(r, Columns.Count).End(xlToLeft).Column
ws2rng = .Cells(r, 2)
ws2rng.Offset(0, 1) = .Cells(r, 1)
Set ws2rng = ws2rng.Offset(0, 2)
For c = 3 To lastcol
If Trim(UCase(.Cells(r, c))) = "YES" Then
ws2rng = .Cells(1, c)
Set ws2rng = ws2rng.Offset(1, 0)
End If
Next c
Set ws2rng = ws2rng.Offset(0, -2)
Next r
End With

End Sub

" wrote:

I seem to be going round in circles trying to get this solved and just
cannot put my finger on it. Basically I have a sheet set out like this
-

Company name Location Product1 Product2 Product3
Company x USA Yes No No
Company y UK Yes Yes No
Company z AUS No No Yes
.......

What I'd like to do is to retain the companies in rows but to have one
row per product that they sell. e.g -

USA Company x Product1
UK Company y Product1
Product2
AUS Company z Product3

I presume that I might have to copy the "UK" and "Company y" on row 3
but for cosmetic sake would prefer not to. I've tried putting the data
into a Pivot table but this doesn't really work when "No" is the value.
I presume that I need to do some kind of validation and then copy/paste
but I'm not sure where to go.

Thanks.