Cycling through files in a folder

hi Kate,

This may need some fine tuning but hopefully it will do what is needed once the changes are made - my idea of not using copy & paste removes the need to flick between files, removes the risk of something else being mistakenly put on the clipboard or the clipboard being cleared while the macro is running (it may be faster too but I'm not sure). I've included the LastCell Function, rather than coding it into the same macro, as you may find it useful for other code development too.

Kate/Dave, some of your code in posts 5 & 6 respectively seems to be missing the dot prefixes for the range or sheet within the With statements.

- fingers crossed...

Option Explicit

Sub Test1()
Dim strExtension As Variant 'change to what this is meant to be - I didn't know if it works as a string
Dim strPath As String
Dim wbOpen As Workbook
Dim wbNew As Workbook
Dim ConsolSht As Worksheet
Dim FirstEmptyOnConsolSht As Range

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

Set wbNew = ThisWorkbook 'change as needed
Set ConsolSht = wbNew.Worksheets("sheet1") 'change as needed
        Do While strExtension <> ""
            Set FirstEmptyOnConsolSht = ConsolSht.Range("a" & LastCell(ConsolSht).Row + 1).Resize(1, 2)
            Set wbOpen = Workbooks.Open(strPath & strExtension)
            With wbOpen
                FirstEmptyOnConsolSht.Value = .Sheets("Sheet3").Range("A3:B3").Value
                .Close SaveChanges:=False
            End With
            Set FirstEmptyOnConsolSht = Nothing
            strExtension = Dir
        Loop

Set ConsolSht = Nothing
Set wbNew = Nothing
Set wbOpen = Nothing

With Application
    .ScreenUpdating = true
    .DisplayAlerts = true
    .EnableEvents = true
End With
End Sub

Function LastCell(ws As Worksheet) As Range
' sourced from http://www.beyondtechnology.com/geeks012.shtml
'to identify the lastcell on a worksheet (& not necessarily the active sheet)
    Dim LastRow As Long
    Dim LastCol As Long
    ' Error-handling is here in case there is not any
    ' data in the worksheet
    On Error Resume Next
    With ws
        ' Find the last real row
        LastRow = .Cells.Find(What:="*", _
                            SearchDirection:=xlPrevious, _
                            SearchOrder:=xlByRows).Row
        LastRow = Application.WorksheetFunction.Max(1, LastRow)
        ' Find the last real column
        LastCol = .Cells.Find(What:="*", _
                            SearchDirection:=xlPrevious, _
                            SearchOrder:=xlByColumns).Column
        LastCol = Application.WorksheetFunction.Max(1, LastCol)
    End With
    On Error GoTo 0
    ' Finally, initialize a Range object variable for
    ' the last populated row.
    Set LastCell = ws.Cells(LastRow, LastCol)
End Function

hth
Rob