Iterate a sequence for every file in a folder

[icedMrT]

So I have a whole bunch of workbooks that I want to do the same thing to. How can I loop the below bit of code for every file in a given folder?

    Windows("Inputexample1.xlsm").Activate
    Sheets("Wool").Select
    Range("A8:A23").Select
    Selection.Copy
    Windows("TestMasterSpreadsheet.xlsx").Activate
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("Inputexample1.xlsm").Activate
    Sheets("Blue").Select
    Range("A7:A9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("TestMasterSpreadsheet.xlsx").Activate
    Range("AI3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

Need a whole lot of things transposed into one workbook (testmasterspreadsheet). from the inputs (inputexample1, inputexample2...)

 

[Rijnsent]

Hi icedMrT,

there are various examples available online, but here you go, something like this:

Sub DoThisForAll()

Set ActWb = ActiveWorkbook

MyPath = Dir("c:\testfolder\")

sFil = Dir(MyPath & "*.xlsx") 'change or add formats
ResRw = 3 'Variable for the row where the results should be pasted

Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped            through
    
    Set SrcWb = Workbooks.Open(sPath & "\" & sFil) 'opens the file
    ' do something
    SrcWb.Worksheets("Wool").Range("A8:A23").Copy
    
    ActWb.Worksheets("Resultworksheet").Range("A" & ResRw).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    ResRw = ResRw + 1
    
    SrcWb.Close True
    sFil = Dir
Loop

Set ActWb = Nothing

End Sub

Hope this gets you going,

Koen

 

[icedMrT]

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\Work\testfolder\"
Filename = Dir(Path & "*.xls*")

'--------------------------------------------
'OPEN EXCEL FILES
   Dim no As Integer
   'no is the variable representing row number'
   no = 2

 Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
    Set wbk = Workbooks.Open(Path & Filename)

CODE
CODE
CODE

wbk.Close True
    Filename = Dir
    
    no = no + 1
Loop

Thanks for the reply, did manage to find an example on the net and went with the above one. Looks very similar to the one you posted.