Vba copy and update data in Master wkbk- only copies from the first workbook right below it

[Clairexcel]

Hello everyone,

I have a VBA code that copies all the data from all the workbooks existing in the folder and pastes them in the Masterbook (which has to be in the same folder).
It worked fine at first, thank to some adjustments/help I got from this forum, but now, it only copies the data from the workbook sitting right below it (below the master book), and does not copy the data from the other three workbooks in the folder. This is very strange.
1. The code is in the Masterbook, in a module
2. The workbooks, Master wkbk included, are in xlsb (binary format), while at first when I got this code they were xlsm (but it worked fine a xlsb too)
3. There are named ranges in the workbooks (I don't think this could be an issue)

This is the code I have, any help will be highly appreciated, as I already installed it at work place and it worked fine but now it doesn't copy all the workbooks anymore. ..Please help.

Sub Update_allwkbks()
Dim wb As String
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Aggiorna le pratiche").UsedRange.Offset(1, 0).ClearContents
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
With Workbooks(wb).Sheets(1)
.UsedRange.Offset(1).Copy ThisWorkbook.Sheets("Aggiorna le pratiche").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
Application.CutCopyMode = False
Workbooks(wb).Close False
End If
wb = Dir
Loop
Application.ScreenUpdating = True
End Sub

 

[NdNoviceHlp]

Hi Clairexcel. I've had problems in the past with the DIR function not finding all files even though they exist so I only use the file scripting object. I've re-done your code to reflect same. You will need to change the "YourFolderName" to the actual name of your folder. Please save a copy of your wb before trialing the code. HTH. Dave

Sub Update_allwkbks()
Dim FSO As Object, FolDir As Object, FileNm As Object
On Error GoTo erfix
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Aggiorna le pratiche").UsedRange.Offset(1, 0).ClearContents
Set FSO = CreateObject("scripting.filesystemobject")
Set FolDir = FSO.GetFolder(ThisWorkbook.Path & "\YourFolderName")
For Each FileNm In FolDir.Files
If FileNm.Name <> ThisWorkbook.Name Then
Workbooks.Open Filename:=FileNm
With Workbooks(FileNm.Name).Sheets(Sheets(1))
.UsedRange.Offset(1).Copy ThisWorkbook.Sheets("Aggiorna le pratiche").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
Application.CutCopyMode = False
Application.DisplayAlerts = False
Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next FileNm

erfix:
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Error"
End If
Set FolDir = Nothing
Set FSO = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Marc L]

I've had problems in the past with the DIR function not finding all files even though they exist

Hi, happens only with a bad setup of the Dir parameters or scanning a network rather than a local drive.​

​

The drawback of FSO as it scans all files by default it is slower than VBA Dir function in particular for scanning usual files.​

As an example to search all *.xls* files on an entire volume FSO needed 2'15'', VBA Dir function less than 20" and via Windows functions less than 10" …​