VBA: Copy specific range from multiple workbooks into one worksheet - vba

Question

I have a folder with lots (hundreds) of locked .xls files.
I need to copy a specific range from one of the worksheets in each file into one big worksheet, which would be my data file for future analysis.
I tried to write a macro for this, but keep getting errors.
Please help me debug what I wrote:
Sub ProcessFiles()
' declarations & definitions
Dim Pathname As String
Dim Filename As String
Dim sourceWB As Workbook
Dim targetWB As Workbook
targetWB = ActiveWorkbook
Pathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xls")
' loop through all files in folder
Do While Filename <> ""
Set sourceWB = Workbooks.Open(Pathname & Filename)
' unlock worksheets
sourceWB.Sheets(4).Visible = True
sourceWB.Sheets(4).Unprotect Password:="Password"
sourceWB.Sheets(2).Unprotect Password:="Password"
' create new worksheet
sourceWB.Sheets.Add After:=8
' copy required cells to new sheets
sourceWB.Sheets(2).Range("A14:FM663").Copy Destination:=sourceWB.Sheets(9).Range("C2")
' fill columns for all rows
sourceWB.Sheets(9).Range("A2:A663").Value = sourceWB.Name
sourceWB.Sheets(9).Range("B2:B663").Value = Worksheets(4).Range("C13").Value
'move AuxSheet to taget workbook
sourceWB.Sheets(9).Move Before:=Workbooks(targetWB).Sheets(1)
'add to full data worksheet
targetWB.Sheets(1).Range("A2:FO651").Copy Destination:=sourceWB.Sheets(2).Rows("3:" & Worksheets("Sheet2").UsedRange.Rows.Count)
'close file and repeat
sourceWB.Close SaveChanges:=False
Filename = Dir()
Loop
' save result
targetWB.Save
End Sub

Answer 1

Just to give you an idea of how tasks like this can be handled way more efficient... consider the following that I always use for tasks like this:
Option Explicit
' 1. Add reference to Microsoft Scripting Runtime and Access Data Objects Library via Extras>References
Sub ProcessFiles()
Dim strCon As String
Dim strSQL As String
Dim fso As New Scripting.FileSystemObject
Dim myfile As file
With ThisWorkbook
' 2. empty your outputsheet
.Sheets("out").Cells.Clear
' 3. loop the files in your folder
For Each myfile In fso.GetFolder(.Path & Application.PathSeparator & "Files").Files
' 3.1. no proper way to filter files like in Dir(), but we want to use the file objects
If myfile.Name Like "*.xls" Then
' 3.1.1. Construct the connection string, the only variable part is myfile.Path
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myfile.Path & ";Extended Properties='Excel 8.0;HDR=YES';"
' 3.1.2. Construct the SQL String. Luckily, you already know where your data is
strSQL = "SELECT '" & myfile.Name & "' AS WorkbookName, * FROM [sheetData$A1:C5], (SELECT TOP 1 * FROM [sheetSchool$C12:C13])"
' 3.1.3. Call the get-data sub from below
GetData .Sheets("out"), strCon, strSQL
End If
Next myfile
End With
End Sub
Sub GetData(ByRef wsOut As Variant, strCon As String, strSQL As String)
Dim i As Integer
On Error GoTo skpError
Application.ScreenUpdating = False
' Create a new database connection
Dim objCon As New ADODB.Connection
With objCon
.ConnectionString = strCon
.Open
End With
' Create a new database command
Dim objCmd As New ADODB.Command
With objCmd
.ActiveConnection = objCon
.CommandType = adCmdText
.CommandText = strSQL
Debug.Print .CommandText
End With
' Create a new recordset
Dim objRS
Set objRS = New ADODB.Recordset
With objRS
.ActiveConnection = objCon
.Open objCmd
End With
' Print your FieldNames, in case they're not already there
With wsOut
If wsOut.Cells(1, 1).Value = vbNullString Then
For i = 1 To objRS.Fields.Count
.Cells(1, i).Value = _
objRS.Fields(i - 1).Name
Next i
End If
' Output your data - pretty ugly, but reliable
.Range("A1048576").End(xlUp).Offset(1, 0).CopyFromRecordset (objRS)
End With
skpNoError:
Application.ScreenUpdating = True
Exit Sub
skpError:
MsgBox "Error #" & Err & vbNewLine & Error, vbCritical
GoTo skpNoError
End Sub
Notes: (why use something like this?)
protected and hidden worksheets shouldn't be a problem with this. For protected workbooks, a password parameter can be added to the connection string
this will be considerably faster for a large number of files than opening, editing, copying would be. If you feel fancy, you can further speed things up by moving stuff from the GetData-Sub to ProcessFiles, so they won't get called repeatedly.
you use a database language for querying data instead of some clumsy copy/paste mechanism.
Edit:
Edited my code, for me this works with the example you gave.
From what i gather, you only got protected Worksheets, not a password-protected Workbook - therefore there's no need to unhide or unprotect your worksheets
adjust the line strSQL = "SELECT '" & myfile.Name & "' AS WorkbookName, * FROM [sheetData$A1:C5], (SELECT TOP 1 * FROM [sheetSchool$C12:C13])" to contain your actual Sheets(2) and Sheets(4) names