Copy row until cell not empty - vba

Question

Thanks for any help you can provide. I have managed using a macro to search through folders and sub folders and hyperlink them and display Folder 1 in column A the files that is in the folder in column B.
There is about 200 folders and some 1600 files. Anyway I want to be able to place a button and attach a macro to that button that will enable only the folder and files names be to copy from that buttons position.
I was thinking of placing that button in column D directly across from the folder name in column A

Answer 1

The code does something similar to what you appear to want. It recursively (see TraversePath subroutine) finds all the paths and files in them and prints them out to "Sheet1" in the same manner as the image you posted with your question: the file folder names are written out to column 'A' (as a hyperlink), the files in that folder are written out to column 'B' (again as hyperlinks) and a button is placed in column 'C'.
Modify 'CreateDirSheet' with the root or top directory for which you want all sub-folders and files printed out in 'Sheet1'. The '1' argument to 'TraversePath' is the row # of where to start printing out the folders/files in 'Sheet'.
The TraversePath subroutine places the buttons and identifies the macro handler that is processed when the button is pressed. Two arguments are passed to that routine: the name of the sheet (it'll be 'Sheet1' in this case) and the row number from where the folder is given in column 'A'.
When a button is pressed the handler prompts the user for the destination path and goes down the list in column 'B' copying all the files from the source folder (in column 'A') to the destination folder provided by the user.
It's probably not entirely what you're after but should be a good starting point to get the functionality you want.
Option Explicit
' Button event handler
Sub CopyDirBtn(shtName As String, rs As String)
Dim sht As Worksheet
Set sht = Worksheets(shtName)
' Get the destination path (where to copy files) from user
Dim dpath As String, spath As String
Dim fdialog As FileDialog
Set fdialog = Application.FileDialog(msoFileDialogFolderPicker)
With fdialog
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> 0 Then
dpath = .SelectedItems(1)
Else
Exit Sub
End If
End With
' Copy all files
Dim r As Integer: r = CInt(rs)
With sht
spath = .Cells(r, "A")
r = r + 1
Do While .Cells(r, "B") <> ""
FileCopy spath & .Cells(r, "B"), dpath & "\" & .Cells(r, "B")
r = r + 1
Loop
End With
End Sub
' Populate sheet with folder/link links and buttons
Sub TraversePath(path As String, r As Integer)
Dim currentPath As String, directory As Variant
Dim dirCollection As Collection
Set dirCollection = New Collection
currentPath = Dir(path, vbDirectory)
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
With sht
'Add directory and hyperlink to sheet
.Hyperlinks.Add Anchor:=.Cells(r, "A"), _
Address:=path, _
TextToDisplay:=path
' Add copy button
Dim copyBtn As Button
Set copyBtn = .Buttons.Add(Cells(r, "C").Left, _
Cells(r, "C").Top, 100#, 14#)
With copyBtn
.Caption = "Copy Files"
.Name = "copyBtn_" & r
.Locked = False
.OnAction = "'CopyDirBtn """ & sht.Name & """, """ & r & """'"
End With
' Add files and hyperlinks to sheet
r = r + 1
Do Until currentPath = vbNullString
If Left(currentPath, 1) <> "." And _
(GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
dirCollection.Add currentPath
Else
If currentPath <> "." And currentPath <> ".." Then
.Hyperlinks.Add Anchor:=.Cells(r, "B"), _
Address:=path, _
TextToDisplay:=currentPath
r = r + 1
End If
End If
currentPath = Dir()
Loop
End With
'process remaining directories
For Each directory In dirCollection
TraversePath path & directory & "\", r
Next directory
End Sub
' This is the main macro that populates the sheet
' Modify first parameter so it's your root folder path
Sub CreateDirSheet()
TraversePath "D:\tmp\", 1
End Sub