Barking up the wrong tree

HappyChappy

Active Member
Joined
Jan 26, 2013
Messages
378
Office Version
  1. 2019
  2. 2010
  3. 2007
Platform
  1. Windows
Hi is it possible I have seven wookbooks stored in numbered week folders each workbook is dated sun01.11.19 to sat07.11.19 . I need to be able to enter the folder name week 45 and each of the seven wookbooks within opened and sheet1 from each be combined into a new wookbook.
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Hello HappyChappy,

This will ask you to choose the folder and enter the week number. This probably could be done in a single step. But, I would need to see a example of the actual path.

The macro assumes the week folder holds the workbooks for that week. It will open each file in the folder and copy the first sheet to a new workbook with a name like "Week 45.xlsx".

Here is the VBA macro code...

Code:
Option Explicit


Sub CombineWorkbooks()


    Dim oFile   As Object
    Dim oFiles  As Object
    Dim oFolder As Object
    Dim NewFile As String
    Dim Path    As Variant
    Dim RngDst  As Range
    Dim RngSrc  As Range
    Dim WkNum   As Integer
    Dim WkbDst  As Workbook
    Dim WkbSrc  As Workbook
    
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Select Weekly Folder"
            If .Show Then Path = .SelectedItems(1) Else Exit Sub
        End With
                        
        ' // Ask the user for the week number.
        WkNum = InputBox("Enter the Week number of the folder.")
        If WkNum = 0 Then Exit Sub
        
        ' // Name of New Workbook.
        NewFile = Path & "\Week " & WkNum & ".xlsx"
        
            ' // Create the Destination workbook and assign it's object variables.
            Set WkbDst = Workbooks.Add(xlWBATWorksheet)
            Set RngDst = WkbDst.Worksheets("Sheet1").Range("A1")
        
            With CreateObject("Shell.Aplication")
                Set oFolder = .Namespace(Path)
                Set oFiles = oFolder.Items
            End With
        
            ' // Open each workbook in the folder and copy it to the new workbook.
            For Each oFile In oFiles
                'WkDay = Format(WkBeg + n, "ddd")
                Set WkbSrc = Workbooks.Open(oFile)
                Set RngSrc = WkbSrc.Worksheets(1).UsedRange
                RngSrc.Copy Destination:=RngDst
                Set RngDst = RngDst.Offset(RngSrc.Rows)
                WkbSrc.Close SaveChanges:=False
            Next oFile
        
        ' // Save the New Workbook and close it.
        WkbDst.SaveAs NewFile
        WkbDst.Close
        
End Sub
 
Upvote 0
S:\freddy\Harlow\Daily Debrief Night Folder\Debriefs\2019\11 - November\Week 46



File name harlow debrief 11.11.2019

Harlow debrief 12.11.2019

Harlow debrief 13.11.2019

Harlow debrief 14.11.2019

Harlow debrief 15.11.2019

Harlow debrief 16.11.2019

Harlow debrief 17.11.2019



First sheet in each file is called plan

File to open and place macro in is called Harlow hours tracker master

S:\freddy\Harlow\Daily Debrief Night Folder\hours tracker\harlow hours tracker master

So in whats needed is to open harlow hours tracker master run macro which asks for the week number and then fetches the data from the seven wookbooks and pastes the plan from each sheet into the harlow hours tracker master
Hope this explains what I need clearly
Thankyou
 
Upvote 0
Hello Happy Chappy,

This macro should be copied into a new workbook. This will open the Harlow Hours Tracker workbook, ask for the week number and copy the files from the folder "S:\freddy\Harlow\Daily Debrief Night Folder\Debriefs\2019\11 - November\Week nn", where nn is the week number input by the user. Valid week numbers are from 1 to 52.

The macro uses the current date to automatically select the year and month for the source folder path. I assumed the "11 - November" to be the month number and name. If it is not, let me know.

Here is the updated macro...
Rich (BB code):
Rich (BB code):
Option Explicit

Sub CombineWorkbooks()


    Dim DstFile As String
    Dim LastRow As Long
    Dim oFile   As Object
    Dim oFiles  As Object
    Dim oFolder As Object
    Dim NewFile As String
    Dim Path    As Variant
    Dim RngDst  As Range
    Dim RngSrc  As Range
    Dim WkNum   As Variant
    Dim WkbDst  As Workbook
    Dim WkbSrc  As Workbook
    
        ' // Source path for the workbooks.
        Path = "S:\freddy\Harlow\Daily Debrief Night Folder\Debriefs\" _
                & Year(Now) & "\" & Month(Now) & " - " & Format(Now, "mmmm") & "\"
        
InputWeekNumber:
        ' // Ask the user for the week number.
        WkNum = InputBox("Enter the Week number of the folder.")
            If WkNum = "" Then Exit Sub
        
        WkNum = Int(Val(WkNum))
            If WkNum < 1 Or WkNum > 52 Then
                MsgBox "You have entered an invalid week number."
                GoTo InputWeekNumber
            End If
        
        ' // Finish the source folder path using the week number.
        Path = Path & "Week " & WkNum
        
        ' // Full path of destination Workbook.
        DstFile = "S:\freddy\Harlow\Daily Debrief Night Folder\hours tracker\harlow hours tracker master" & ".xlsx"
        
            ' // Create the Destination workbook and assign it's object variables.
            Set WkbDst = Workbooks.Open(DstFile)
                LastRow = WkbDst.Worksheets("Sheet1").Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False, False).Row
            
            ' // Enter new data 1 row below the last row with data.
            Set WksRng = WkbDst.Cells(LastRow, "A").Offset(1, 0)
            
            ' // Get all the files in the source folder.
            With CreateObject("Shell.Aplication")
                Set oFolder = .Namespace(Path)
                Set oFiles = oFolder.Items
                    oFiles.Filter 64, "Harlow debrief *.*"
            End With
        
            ' // Open each workbook in the source folder and copy it to the new workbook.
            For Each oFile In oFiles
                Set WkbSrc = Workbooks.Open(oFile)
                Set RngSrc = WkbSrc.Worksheets("Plan").UsedRange
                RngSrc.Copy Destination:=RngDst
                Set RngDst = RngDst.Offset(RngSrc.Rows)
                WkbSrc.Close SaveChanges:=False
            Next oFile
        
        WkbDst.Close SaveChanges:=True
        
End Sub
 
Last edited:
Upvote 0
Hi ran the macro and get a compile error
Stops at set wksRng =
 
Upvote 0
Hello HappyChappy,

Sorry about that. Change WksRng to RngDst.
 
Upvote 0
Still get compile error variable not set now on line WksDat =
 
Upvote 0
Hello HappyChappy,

My guess is the workbook was not found. Check the file path is correct by stepping through the macro code or setting break points to inspect the variables.

How To Step Through A Macro

  • Open the Visual Basic Editor by pressing the ALT and F11 keys.
  • Double Click the module containing your macro to display it the Code Pane window.
  • Press the F8 key to start at the Sub or Function line of the macro.
  • Press Shift and F8 keys to execute the next line of code.
  • Place your cursor on the variable to see the value.
 
Upvote 0
It's on a networked drive I will transfer it to a locale drive to run the macro and check it works first.
 
Upvote 0
getting somewhere now the path was not being found that is fixed it asks for the week and opens the tracker file but errors at

LastRow = WkbDst.Worksheets("sheet1").Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False, False).Row

it asks for the week and opens the tracker but not the workbooks where the data is stored.
 
Upvote 0

Forum statistics

Threads
1,214,386
Messages
6,119,215
Members
448,874
Latest member
b1step2far

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top