Dear All,

After lots of help yesterday from RoyUK, I now have the following macro. However, this gives me a compile error Block if without End If but I do have an End If statement.

Sub Copy_Balances_to_Database()
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Variance").Select
    Range("A4:D447").Select
    Selection.Copy
    Workbooks.Open fileName:= _
        "V:\Treasury Group\PLC Treasury Folders\Annabel F\Projects\UK Cash Spreadsheet\Bank Balance database.xls"
    Sheets("Worksheet").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("TC GBP Pooled").Select
    Dim DateRng As Range
    Dim cl     As Range
    Dim dte    As Date
    With Worksheets("TC GBP Pooled")
        dte = CDate(Cells(1, 2).Value)
        Set DateRng = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set cl = DateRng.Find(dte, LookIn:=xlValues)
        If Not cl Is Nothing Then
            Sheets("Worksheet").Range("C2:C31").Copy
            cl.Offset(, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    Sheets("TC GBP Non Pooled").Select
    With Worksheets("TC GBP Non Pooled")
        dte = CDate(Cells(1, 2).Value)
        Set DateRng = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set cl = DateRng.Find(dte, LookIn:=xlValues)
        If Not cl Is Nothing Then
            Sheets("Worksheet").Range("C34:C39").Copy
            cl.Offset(, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    Sheets("USD").Select
    With Worksheets("USD")
        dte = CDate(Cells(1, 2).Value)
        Set DateRng = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set cl = DateRng.Find(dte, LookIn:=xlValues)
        If Not cl Is Nothing Then
            Sheets("Worksheet").Range("C43:C58").Copy
            cl.Offset(, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    Sheets("EUR").Select
    With Worksheets("EUR")
        dte = CDate(Cells(1, 2).Value)
        Set DateRng = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set cl = DateRng.Find(dte, LookIn:=xlValues)
        If Not cl Is Nothing Then
            Sheets("Worksheet").Range("C61:C78").Copy
            cl.Offset(, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    Sheets("CAD").Select
    With Worksheets("CAD")
        dte = CDate(Cells(1, 2).Value)
        Set DateRng = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set cl = DateRng.Find(dte, LookIn:=xlValues)
        If Not cl Is Nothing Then
            Sheets("Worksheet").Range("C81:C85").Copy
            cl.Offset(, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    Sheets("Other Currency").Select
    With Worksheets("Other Currency")
        dte = CDate(Cells(1, 2).Value)
        Set DateRng = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
        Set cl = DateRng.Find(dte, LookIn:=xlValues)
        If Not cl Is Nothing Then
            Sheets("Worksheet").Range("C88:C114").Copy
            cl.Offset(, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Process").Select
        End If
    End With
End Sub
Any ideas?

Thanks
DB