# Copy range of cells from closed workbooks • ### Question

• Hi,

Is there a way to loop thru a folder (That have Excel files) and for each workbook find the last row and copy a specific range (that is changing since each workbook has different last row) to target workbook without opening the files.

I did a loop that opens each one of the files, calculates the last row and copy the range to the target workbook, then the workbook is closed and going to the next file.

Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(PathName)

For Each file In folder.Files
Workbooks.Open file
Call CopyFromSimFile    'Copy a specific range
ActiveWorkbook.Close savechanges:=False
Next file

Guy Zommer

Sunday, February 26, 2012 9:23 AM

• Guy  and what, do you try eny method?

Oskar Shon, Office System MVP

Press if Helpful; Answer when a problem solved

• Marked as answer by Wednesday, February 29, 2012 4:47 AM
Tuesday, February 28, 2012 10:02 PM
• Thanks

Guy Zommer

• Marked as answer by Wednesday, February 29, 2012 4:49 AM
Wednesday, February 29, 2012 4:49 AM

### All replies

• 1st GetValue Function

```Sub getValie()
Dim P As String
Dim F As String
Dim s As String
Dim r As Long, c As Long
Dim a, ile_wierszy As Long, ile_kolumn As Long

P = Left(FileName, Len(FileName) - Len(Dir(FileName)) - 1)
F = Dir(FileName)
s = "Arkusz1"
ile_wierszy = 0
Application.ScreenUpdating = False
'sprawdzenie ile jest wierszy
For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If GetValue(P, F, s, a) <> 0 Then
ile_wierszy = ile_wierszy + 1
Else
Exit For
End If
Next r
'sprawdzenie ile jest kolumn
For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If GetValue(P, F, s, a) <> 0 Then
ile_kolumn = ile_kolumn + 1
Else
Exit For
End If
Next c
'kopiowanie danych
For r = 1 To ile_wierszy
For c = 1 To ile_kolumn
If GetValue(P, F, s, a) = 0 Then
Cells(r, c) = ""
Else
Cells(r, c) = GetValue(P, F, s, a)
End If
Next c
Next r
Application.ScreenUpdating = True
End Sub
Private Function GetValue(path, file, sheet, ref)
Dim Arg As String

If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "Plik nie został znaleziony."
Exit Function
End If

Arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("a1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(Arg)
End Function```

2nd SQL Method

```Sub Importuj()
Dim ok As Boolean
Dim MyFile\$: MyFile = "C:\Temp\test ok.xlsx"
Dim MyName\$: MyName = "aaa"

ok = tabela(MyFile, MyName, Rows(Rows.Count).End(xlUp).Row)
Debug.Print ok
End Sub

Function tabela(ByVal MyFile\$, MyName\$, Optional MyEndStart&) As Boolean
Dim MyPath\$: MyPath = Left(MyFile, InStrRev(MyFile, "\"))
If Len(MyEndStart) = 0 Or MyEndStart = 1 Then MyEndStart = 0
If InStr(1, MyName, " ") Then MyName = "'" & MyName & "\$'"
Array("ODBC;DSN=Excel Files;DBQ=" & MyFile & ";"), _
Array("DefaultDir=" & MyPath & ";DriverId=1046;MaxBufferSize=2048;"), _
Array("PageTimeout=5;")), _
Destination:=Range("\$A\$" & MyEndStart + 1)).QueryTable
.CommandText = Array("SELECT * FROM `" & MyFile & "`.`" & MyName & "`")
.Refresh BackgroundQuery:=False
End With
tabela = True
Exit Function
tabela = False
End Function```

Oskar Shon, Office System MVP

Press if Helpful; Answer when a problem solved

Sunday, February 26, 2012 4:17 PM
• If your data is usefully structured in Excel, then the last row number isn't needed. Try reading:

http://support.microsoft.com/kb/278973

Rod Gill

The one and only Project VBA Book Rod Gill Project Management

Sunday, February 26, 2012 7:52 PM
• Guy  and what, do you try eny method?

Oskar Shon, Office System MVP

Press if Helpful; Answer when a problem solved

• Marked as answer by Wednesday, February 29, 2012 4:47 AM
Tuesday, February 28, 2012 10:02 PM
• Thanks

Guy Zommer

• Marked as answer by Wednesday, February 29, 2012 4:49 AM
Wednesday, February 29, 2012 4:49 AM