Macro merger of filenames that start with a specific name

RAZE

New Member
Joined
Feb 27, 2020
Messages
4
Office Version
365, 2019
Platform
Windows, Web
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 ?

VBA 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
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

RAZE

New Member
Joined
Feb 27, 2020
Messages
4
Office Version
365, 2019
Platform
Windows, Web
Correction: filenames start with "BRIDGE"
 

Watch MrExcel Video

Forum statistics

Threads
1,099,253
Messages
5,467,563
Members
406,543
Latest member
semoredhawk

This Week's Hot Topics

Top