Macro merger of filenames that start with a specific name

arestyus · May 8th 2020

Hello,

I have a macro that consolidates all filenames that start with "BDRIDGE" and have a "DATAx" sheet.name from all containing subfolders. The path of the subolders being added in the 1st sheet of the macro file.

My problem is that the macro does not retrieve anything as it only runs and creates a blank new sheet without data.

Any help please ? ( zip archive attached also)

Code

Sub CopWKBooksInFolder()
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
Str = Application.InputBox(prompt:="Search only sheet names containing this string:", Title:="Search worksheet whose name contain this string:", Type:=2)
On Error Resume Next
Set Rng = Application.InputBox(prompt:="Select a cell range containing paths to folders" _
, Title:="Select a cell range", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0
Set WS = Sheets.Add
For Each cell In Rng
If Dir(cell.Value, vbDirectory) <> "" Then
chk = 0
Value = Dir(cell.Value)
Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If Left(Value, 6) = "BRIDGE" Then
On Error Resume Next
Workbooks.Open Filename:=cell.Value & Value
If Err.Number > 0 Then
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
If InStr(sht.Name, Str) <> 0 Then
If sht.Range("A1") <> "" Then
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
If chk = 0 Then
sht.Range("A1").CurrentRegion.Copy Destination:=WS.Range("A" & Lrow)
chk = 1
Else
Set crng = sht.Range("A1").CurrentRegion
Set crng = crng.Offset(1, 0)
Set crng = crng.Resize(crng.Rows.Count - 1)
crng.Copy Destination:=WS.Range("A" & Lrow)
End If
End If
End If
Next sht
End If
Workbooks(Value).Close False
On Error GoTo 0
End If
End If
Value = Dir
Loop
End If
Next cell
Cells.EntireColumn.AutoFit
End Sub

Display More

Testing.zip Testing.zip

arestyus · May 8th 2020

Correction: filenames start with "BRIDGE"

dangelor · May 9th 2020

You might try 2 simple things before debugging the code

1. Use Option Explicit at the beginning of you code module to catch any misspelled variables

2. Remove all the On Error Resume Next / On Error Goto 0 lines of code - they may be hiding a problem

**royUK** · May 10th 2020

arestyus, please take a few minutes to read the Forum Rules, then you will understand why I have added Code Tags in your post.

**royUK** · May 10th 2020

Is this any better? I've changed what range is defined for copying

Code

Sub CopWKBooksInFolder()
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
Str = Application.InputBox(prompt:="Search only sheet names containing this string:", Title:="Search worksheet whose name contain this string:", Type:=2)
On Error Resume Next
Set Rng = Application.InputBox(prompt:="Select a cell range containing paths to folders" _
, Title:="Select a cell range", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0
Set WS = Sheets.Add
For Each cell In Rng
If Dir(cell.Value, vbDirectory) <> "" Then
chk = 0
Value = Dir(cell.Value)
Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If Left(Value, 6) = "BRIDGE" Then
On Error Resume Next
Workbooks.Open Filename:=cell.Value & Value
If Err.Number > 0 Then
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
If InStr(sht.Name, Str) <> 0 Then
If sht.Range("A1") <> "" Then
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
If chk = 0 Then
sht.Range("A1").CurrentRegion.Copy Destination:=WS.Range("A" & Lrow)
chk = 1
Else
Set crng = sht.Range("A1").CurrentRegion
Set crng = crng.Offset(1).Resize(crng.Rows.Count - 1, crng.Columns.Count)
crng.Copy Destination:=WS.Range("A" & Lrow)
End If
End If
End If
Next sht
End If
Workbooks(Value).Close False
On Error GoTo 0
End If
End If
Value = Dir
Loop
End If
Next cell
Cells.EntireColumn.AutoFit
End Sub

Display More

What is Value referring to here. Is it a variable or do you mean Cell.Value?

Code

Value = Dir(cell.Value)

arestyus · May 17th 2020

dangelor , tried but then it's erroring a lot (Rng, cell, chck etc.)

royUK , sorry with the format. Tried your code but still not working.

Technically that part refers to those folder paths inserted in the Range from Sheets "Library" and use them as variable.

dangelor · May 18th 2020

arestyus-

In your code there are two variables that are never referenced:

Code

Dim myfolder As String
Dim a As Single

This leads me to believe that some coding is missing from your sub-routine. Any idea what it was?

Share

Tags