sorry...I'm a terrible idiot and still can't do anything...:-(((

[uriel78]

I'm sorry and feel like an idiot...still can't obtain what I'm trying to
do...:-(((

I'm such a newbie with macro & excel...

Trying to explain what I need...:

In a new workboook I need to copy data in columns (I:J) from 4 different
sheets and

Every exixsting workbook has 4 sheets called "alfa", "beta", "gamma",
"delta". I need to copy (in a new sheet of a new workbook) columns I3:J203
of every sheet for every existing workbook

So in the new sheet, I've got
From Workbook1
I:J columns from "alfa" in A3:B203
I:J columns from "beta" in D3:E203
I:J columns from "gamma" in G3:H203
I:J columns from "delta" in J3:K203

From workboook2
I:J columns from "alfa" in M3:N203
I:J columns from "beta" in P3:Q203
I:J columns from "gamma" in S3:T203
I:J columns from "delta" in V3:W203

....and so on

And, maybe I wish I could put in cell A1,M1... the names of the workbooks
and in A2,B2,C2,D2....the names of the sheets....

really hope you can help me...

 

[Ron de Bruin]

Here is a example

For all files in C:\Data
Copy this macro in a workbook outside that folder and run it

Sub Tester()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim sh As Worksheet

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
Colnum = 1

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
For Each sh In mybook.Sheets(Array("alfa", "beta", "gamma", "delta"))
Set sourceRange = sh.Range("I3:J203")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets(1).Cells(3, Colnum)
sourceRange.Copy destrange
basebook.Worksheets(1).Cells(1, Colnum).Value = mybook.Name
Colnum = Colnum + SourceCcount
Next sh
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

Oops, Change this

This line
basebook.Worksheets(1).Cells(1, Colnum).Value = mybook.Name

must be below this line
Set mybook = Workbooks.Open(FNames)

 

[uriel78]

Thank you very very much.... it runs and rulezzzz!!!!!!

Tomorrow morning I will work on it trying to be able to use getopenfilename
instead of dir() and some other little modifications (pasting values only)
in accord to my data, I will try to study from your sute and
explanations!!!!

 

[Ron de Bruin]

Hi

I will work on it trying to be able to use getopenfilename
instead of dir() and some other little modifications (pasting values only)

You can find the examples on this page
http://www.rondebruin.nl/copy3.htm

Try it first and if you need help post back.
We will help you

 

[uriel78]

....I tried to substitute the dir() procedure with the
Application.GetOpenFilename as shown in Sub GetData_Example3()
http://www.rondebruin.nl/ado.
but without any results :-((((((...
I tried to change the method of the input to avoid moving files that need to
be in some specified folders (as they work together other workbooks).
I believe that this is possible...but as the facts show I have too less
experience with VBA to get it works...

 

[uriel78]

After a couple of minutes after posting I found the solution

Now I'm trying to copy the names of each sheet in rows 2...just above the
imported values...


Sub Tester2()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim sh As Worksheet
Dim FName As Variant, N As Long







SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\Roby\Documenti\Nuova cartella (2)"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xls", _
MultiSelect:=True)

If IsArray(FName) Then
' Sort the Array
FName = Array_Sort(FName)

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
Colnum = 1

'Do While FName <> ""
For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
basebook.Worksheets(1).Cells(1, Colnum).Value = mybook.Name
For Each sh In mybook.Sheets(Array(("alfa", "beta", "gamma",
"delta"))
Set sourceRange = sh.Range("I3:J203")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets(1).Cells(3, Colnum)
sourceRange.Copy destrange

Colnum = Colnum + SourceCcount
Next sh
mybook.Close False
Next
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub