Hi Les,

Try something like:

'================
Public Sub CopyTable()
Dim WB As Workbook
Dim SH As Worksheet
Dim destsh As Worksheet
Dim rng As Range
Dim rCell As Range
Dim copyRng As Range
Dim destrng As Range
Dim CalcMode As Long
Dim ViewMode As Long

Set WB = ActiveWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE
Set destsh = WB.Sheets("Sheet2") '<<===== CHANGE
Set destrng = destsh.Range("A1") '<<===== CHANGE

Set rng = SH.Range("A1", Cells(Rows.Count, "A").End(xlUp))

On Error GoTo XIT

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveWindow
ViewMode = .View
.View = xlNormalView
End With

SH.DisplayPageBreaks = False

For Each rCell In rng.Cells
If Application.CountA(rCell.EntireRow) 1 Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = Union(rCell, copyRng)
End If
End If
Next rCell

If Not copyRng Is Nothing Then
copyRng.EntireRow.Copy Destination:=destrng
Else
'nothing found, do nothing
End If

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

ActiveWindow.View = ViewMode

End Sub
'<<================


---
Regards,
Norman


"Les" wrote in message
...
Could anyone please help
I have what you would call a 'typical' spreadsheet i.e. categories across
row 1, dates down column A then a value against certain categories on
certain
dates.
What I'm trying to do is create a macro that extracts the data, the date
and
and the category to a new work sheet but only where data actually exists.
I'm essentially trying to create a data table from the existing worksheet.
Regards
Les.