Cycling through files in a folder

Hi all,

I'm a novice with VB, so go easy on me. I'm trying to write a macro to copy the same couple of cells from hundreds of excel files and paste them into one summary file. What I've written so far is:

Sub Test()
Dim x As Integer
Dim y As Integer
Dim name As String
Dim name2 As String
Dim wb As String
Dim wb2 As String
x = 3
y = 10
name = "WM19-1-014_00"
name2 = "WM19-1-014_0"
Do While (x < 10)
wb = "name" & "x" & ".xls"
Workbooks("wb").Activate
Range("A3:B3").Copy
Workbooks("data").Worksheets("Sheet1").Activate
Cells(A, "2*x").Paste
x = x + 1
Loop
Do While (y < 63)
wb2 = "name2" & "y" & ".xls"
Workbooks("wb2").Activate
Range("A3:B3").Copy
Workbooks("data").Worksheets("Sheet1").Activate
Cells(A, "2*y").Paste
y = y + 1
Loop
End Sub

Forgive the clumsy break down of the files; they range from 001 to 063, and since I don't know how to set x as a three digit number I decided to have a section for 1-9 and a second section (with the same code) for 10-63.

The problem I think I'm having is in referencing the workbook (the debugger always stops on the worksheets(wb).Activate line). Ideally I'd like the macro to open the files itself, but given that I can't even make it work when they're open I think I should start small. The issue, I believe, is that I'm not referencing the file correctly, since I'm trying to use the 'name + x' format to cycle through the files, and either I'm doing it wrong or this sort of variable referencing isn't suitable for the function. I've tried all manner of different tactics to get the activate workbook function liking my workbook name, but have had no luck.

Any help would be hugely appreciated, and once again, forgive my unsubtle coding.

Kate

Hi,

I think your error may be here

wb = "name" & "x" & ".xls"

this will set wb to namex.xls

try

wb = "name" & x & ".xls"

and

wb2 = "name2" & y & ".xls"

There's a couple of places that you have variables in quotes, which will result in the code not working.

There's a ready made macro here which you may find useful

Try activating a worksheet in wbNew by replacing this:

With wbNew
Cells(1, 1).Select

with this:

With wbNew
Sheets(1).activate
Cells(1, 1).Select

I've used sheet 1 for an example.

This may help (or not); tryu replacing this code

Selection.Paste

with

Selection.PasteSpecial

Hope this helps.
J

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

Thanks for the feedback & marking the thread as solved - I'm pleased we could help :-)

Rob