Hi,
I have several folders with 8-10 files in each folder.
Each file has 14 sheets in them. I want to be able to copy the range (A5:G16) in sheets named Daily to a new file called master. So the Daily sheets range A5:G16 of each file get cpoied vertically in the master file.
I asked this question in Mr.Excel and got the following code. The code must be ok because when I hit F5, while VBA is open, it takes me to the right directory. However, when I created a form control button, it gives me an error message, "can not run the macro 'Import.xlsm!Button1_Ckick'.
So, I am thinking my processes are wrong. I would appreciate it if you could check out the code and provide a step by step of how I should implement this code.
What I did was to put the code in a module, save it, creat a button.
Thanks
Sub tgr()
Dim rngDest As Range
Dim oShell As Object
Dim strFolderPath As String
Dim strFileName As String
Set oShell = CreateObject("Shell.Application")
On Error Resume Next
strFolderPath = oShell.BrowseForFolder(0, "Select a Folder", 0).Self.Path & Application.PathSeparator
Set oShell = Nothing
On Error GoTo 0
If Len(strFolderPath) = 0 Then Exit Sub 'Pressed cancel
Set rngDest = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(2)
strFileName = Dir(strFolderPath & "*.xls")
Application.ScreenUpdating = False
Do While Len(strFileName) > 0
With Workbooks.Open(strFolderPath & strFileName)
If Evaluate("IsRef(Daily!A1)") = True Then
rngDest.Value = strFileName
.Sheets("Daily").Range("A5:G16").Copy rngDest.Offset(1)
Set rngDest = rngDest.Offset(14)
End If
.Close False
End With
strFileName = Dir
Loop
If WorksheetFunction.CountA(rngDest.Parent.Range("A1:A2")) = 0 Then rngDest.Parent.Rows("1:2").EntireRow.Delete xlShiftUp
Application.ScreenUpdating = True
Set rngDest = Nothing
End Sub
Bookmarks