Untested, but something along the lines of this:

Sub abc()
Dim sh As Worksheet
Dim res As Variant
Dim rng As Range, rng1 As Range
Dim rng2 As Range, cnt As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Summary").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "Summary"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < "Summary" Then
Set rng = sh.Range(sh.Cells(3, 1), sh.Cells(3, "IV").End(xlToLeft))
cnt = Application.CountIf(rng, sh.Range("A1"))
If cnt 1 Then
MsgBox sh.Name & " skipped due to bad data"
Else
res = Application.Match(sh.Range("A1"), rng, 0)
If IsError(res) Then
MsgBox sh.Name & " does not have matching column"
Else
Set rng1 = Worksheets("Summary").Cells(Rows.Count, 2) _
.End(xlUp)(2)
Set rng2 = sh.Range(sh.Cells(1, res), sh.Cells(Rows.Count, res) _
.End(xlUp))
rng2.Copy rng1
End If ' iserror(res)
End If ' cnt 1
End If ' sh.Name < "Summary"
Next sh
End Sub

--
Regards,
Tom Ogilvy

"markx" wrote:

Hi there,

Any idea how to write a macro that will:

- copy the columns (say rows 4 to 100) from each sheet within the active
workbook where the value in row 3 = value in cell A1 (there will be only one
column per sheet satisfying this condition - it should give an error if
there are more than 1)
- paste them one under another in column B of a newly created worksheet
(call it "summary")

Thank you very much in advance for your help on this...

Mark