Ask for a VBA code 1

[abiale]

I would like to ask you for help:

There is a folder containing 100-150 files (all of them contain the same format, only data in the cells are different.From each file,I would like to take the values of five specific cells.The adresses of those cells are the same in ALL THE FILES.I would like to take those 5 values and put them in 1 line in a separate table.And so on through these 100-150 files. How can I write macro which would take source data from these specific folder? (instead of running the macro in each of the 150 files?) Is these possible?

I would be very grateful for your eventual help.

Artur Bialek
mail: abiale@sgh.waw.pl

 

[AWithers]

YOu dont say what format the file is in...excel???

if so it should be quite straightforward.

you need to loop through the files collection in your folder and then in each file extract the relevant data.

Sorry I haven't got any code but you will need to make a refernce to the relevant object library e.g. excel etc so that you can get at the data. For this bit I would record a macro in the relevant app

Andy

 

[xlbo]

Sounds like from excel to excel - in which case take a look at these threads:
thread707-329948 for getting values from closed workbooks
thread707-330667 for looping through files in a folder

Combine the 2 and you should be well on your way
Rgds
~Geoff~

 

[abiale]

Thanks a lot for your help! (by the way,the format is Excel, of course, I meant an Excel-Excel macro).

I will try your method.

Artur

mail: abiale@sgh.waw.pl

 

[abiale]

Could anybody of you help me :

I`ve been given this code (at the bottom of my message)which should loop my macro through the files in a specific folder.But the problem is that after GetFolder as I put the path (D:\XYZ\MY Folder)
there is an error, because VB Editor is expecting something different.

What should I write (exactly)after GetFolder?

I would be very grateful for your help.

Artur

mail: abiale@sgh.waw.pl

Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject&quot
Set f = fs.GetFolder(Your folder with path)
Set fc = f.Files
For Each f1 In fc
' Do your thang here
Next f1

 

[AWithers]

I think the path should be in quotes

Andy

 

[xlbo]

For the looping thru files, I was actually thinking of the code that I posted...
Sub LoopFilenames()
Dim filename As String

filename = Dir$("\\Yorkshire\Shared\Plans\*.tif&quot'change to whatever extension you're looking for
'Start File Search
Do While filename <> &quot;&quot;
'Do stuff here
filename = Dir$()
Loop
end sub Rgds
~Geoff~

 

[abiale]

xlbo,

Thanks for your answer - finally I have difficulty writting correctly your method in my case, could you have a look at my code: (the path to the folder where source data are stored is D:\Artur\xyz; all the files *.xls)

Sub VIP_Portfel()
'
Sub LoopFilenames()
Dim (...I don`t know what to write here...*.xls...? As String

filename = Dir$(&quot;\\Artur\XYZ\*.xls&quot'
'Start File Search
Do While filename <> &quot;&quot;
'Dim NazwaPliku
Dim PlikWynikowy
PlikWynikowy = &quot;plik wynikowy1.xls&quot;
NazwaPliku = ActiveWindow.Caption

Range(&quot;C4&quot.Select
Selection.Copy
Windows(PlikWynikowy).Activate
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;F4&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(PlikWynikowy).Activate
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;F14:J14&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(PlikWynikowy).Activate
ActiveSheet.Paste
ActiveCell.Offset(1, -2).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;A4&quot.Select
End Sub
filename = Dir$()
Loop

I would be very grateful for your help,

Regards,

Artur

 

[xlbo]

Sorry for the confusion - filename, in the code that i posted is just a holding variable - it doesn't actually refer to a particular file name. For each loop, the name of the file that is being read is passed to the &quot;filename&quot; variable as a string so...
on the 1st loop filename = &quot;workbook1.xls&quot;
on the 2nd l;oop filename = &quot;Workbook2.xls&quot;

HTH




Rgds
~Geoff~

 

[abiale]

xlbo,

Your code concerning looping through the files works perfectly. My only remaining difficulty is the line where I want to paste special (only values).The VB Editor highlights this line in yellow. Is there any solution to that?

{ the line is: ActiveSheet.Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False}

Here you could find the code.

I hope it will be the last &quot;boring&quot; question.

I will be very grateful for your help,

Artur
mail: abiale@sgh.waw.pl


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

Range(&quot;C4&quot.Select
Selection.Copy
Windows(PlikWynikowy).Activate
ActiveSheet.Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;F4&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(PlikWynikowy).Activate
ActiveSheet.Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;F14:J14&quot.Select
Application.CutCopyMode = False
Selection.Copy
Windows(PlikWynikowy).Activate
ActiveSheet.Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, -2).Range(&quot;A1&quot.Select
Windows(NazwaPliku).Activate
Range(&quot;A4&quot.Select
filename = Dir$()
Loop
End Sub

 

[xlbo]

I think it's because you havn't selected a sheet specifically

Windows(PlikWynikowy).Activate
Sheets(&quot;Name Of Sheet To Paste To&quot.select
'you may also need to select a range
ActiveSheet.Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

HTH
Rgds
~Geoff~

 

[abiale]

xlbo,

Is this correct ?

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

Artur

 

[xlbo]

Range(&quot;C4&quot.Select
Selection.Copy
Windows(PlikWynikowy).Activate
the sheet name cannot be the same as the workbook name
Sheets(&quot;Name of sheet to paste data to&quot.Select
range(&quot;Input Range&quot.select
You need to put the name of the sheet or the sheet index number rather than the workbook name
Other than that, it should work Rgds
~Geoff~

 

[abiale]

xlbo,

Thanks a lot for your help (and patience as well) - the macro works ok, but...it takes several times the data from the first file (there are 15 of them - all *.xls) in the folder D:\Artur\test\) and fulfil the new table with them.

Could you help me how to loop the macro through the rest of the folder?

I really appreciate your help,

(I am very sorry for disturbing you all the time)

Artur
mail: abiale@sgh.waw.pl

PS: Here`s the code:

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

'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]

Have replied to this on your new thread Rgds
~Geoff~