Looping the macro through the files in the folder

[abiale]

Could you help me how to loop the following macro through the rest of the files (*.xls) in the folder (D:\Artur\test\)?

Artur
mail: abiale@sgh.waw.pl

PS: Here`s the code:

Dim filename As String
filename = Dir("D:\Artur\test\*.xls&quot
'Start File Search
Do While filename <> &quot;&quot;
Dim NazwaPliku
Dim PlikWynikowy
PlikWynikowy = &quot;plik wynikowy1.xls&quot;
NazwaPliku = ActiveWindow.Caption

'first cell
Range(&quot;C4&quot.Select
Selection.Copy
Windows(PlikWynikowy).Activate
Sheets(&quot;Arkusz1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate

'second cell
Range(&quot;F4&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(PlikWynikowy).Activate
Sheets(&quot;Arkusz1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate

'third cell
Range(&quot;F14:J14&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(PlikWynikowy).Activate
Sheets(&quot;Arkusz1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, -2).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;A3&quot.Select
filename = Dir$()
Loop
End Sub

 

[xlbo]

This will enable you to loop but you'll need to OPEN the file before you can ACTIVATE it

Dim filename As String
Dim NazwaPliku
NazwaPliku = Activeworkbook.name

filename = Dir(&quot;D:\Artur\test\*.xls&quot
'Start File Search
Do While filename <> &quot;&quot;

'first cell
Range(&quot;C4&quot.Select
Selection.Copy
workbooks(filename).open
Windows(filename).Activate
Sheets(&quot;Arkusz1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate

'second cell
Range(&quot;F4&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(filename).Activate
Sheets(&quot;Arkusz1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate

'third cell
Range(&quot;F14:J14&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(filename).Activate
Sheets(&quot;Arkusz1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, -2).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;A3&quot.Select
filename = Dir$()
Loop
End Sub

There is a lot of tidying and speeding up that could be done here but this should work Rgds
~Geoff~

 

[abiale]

But is it possible that:

1. this macro takes data from files in a specific folder WITHOUT opening those files (around 150-200). There are too much of them to run the macro on each file separately.

2. Is it possible to write the macro using the previous method (Dim filename As String
filename = Dir(&quot;D:\Artur\test\*.xls&quot
'Start File Search
Do While filename <> &quot;&quot;
Dim NazwaPliku
Dim PlikWynikowy
PlikWynikowy = &quot;plik wynikowy1.xls&quot;
NazwaPliku = ActiveWindow.Caption)

instead of your last piece of advice?

Thanks in advance,

Artur