Barking up the wrong tree

HappyChappy

Board Regular
Joined
Jan 26, 2013
Messages
182
Office Version
2019, 2010, 2007
Platform
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.
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,878
Office Version
2010, 2007
Platform
Windows
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
 

HappyChappy

Board Regular
Joined
Jan 26, 2013
Messages
182
Office Version
2019, 2010, 2007
Platform
Windows
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
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,878
Office Version
2010, 2007
Platform
Windows
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:

HappyChappy

Board Regular
Joined
Jan 26, 2013
Messages
182
Office Version
2019, 2010, 2007
Platform
Windows
Hi ran the macro and get a compile error
Stops at set wksRng =
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,878
Office Version
2010, 2007
Platform
Windows
Hello HappyChappy,

Sorry about that. Change WksRng to RngDst.
 

HappyChappy

Board Regular
Joined
Jan 26, 2013
Messages
182
Office Version
2019, 2010, 2007
Platform
Windows
Still get compile error variable not set now on line WksDat =
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,878
Office Version
2010, 2007
Platform
Windows
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.
 

HappyChappy

Board Regular
Joined
Jan 26, 2013
Messages
182
Office Version
2019, 2010, 2007
Platform
Windows
It's on a networked drive I will transfer it to a locale drive to run the macro and check it works first.
 

HappyChappy

Board Regular
Joined
Jan 26, 2013
Messages
182
Office Version
2019, 2010, 2007
Platform
Windows
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.
 

Forum statistics

Threads
1,089,438
Messages
5,408,221
Members
403,191
Latest member
fmstation

This Week's Hot Topics

  • help please
    SORRY NOT ANY GOOD AT EXCEL SO HELP WOULD BE MUCH APPRECIATED this formula is in a sheet called ignore...
  • two formulas needed
    Hello, I'll try my best to explain this: First formula needed in Sheet1 cell A2: If Sheet1 cell B2 = Sheet2 cell B2 then return a 1. If not then...
  • Dynamic Counts
    Good afternoon, we are tidying up some data & the data seems to be growing quicker than we are tidying it up! What we confirm (by reviewing it...
  • Help Excel formula eliminate duplicate values and keep only 2 identical rows.
    as picture below column A has a duplicate value. but the values are not the same as the rule. sometimes 4 rows, sometimes 10 rows or 7 or 9...
  • Macro Compile Error Sub or Function not defined
    Hello, I am trying to run macros from a validation list, all macros have been created and run perfectly on there own but I'm getting a compile...
  • Last row combined with Current Region VBA
    I'm generally happy finding the last row of data through something like Lastrow = Cells(Rows.Count, "D").End(xlUp) but I don't always receive data...
Top