Need to loop thru workbooks and copy total rows to a master workbook

[glennpc]

I have a set of workbooks in a folder on my Desktop, each of which has a timecard in it on a worksheet called Weekly Time Sheet. On each of the sheets, I'm interested in totals that appear in E14 through K14 (7 cells), and I want to loop through the workbooks, open them, copy the contents of E14:K14 to a grid on a master workbook first to B3:H3, then to C3:H3, then to D3:H3, and so forth until I've processed all the workbooks in the folder. Then I guess I need to close all of the workbooks and put up a message box indicating that the transfer process is complete.

I have code so far that does the looping, and to test it, I put up a simple message box with each file's name. I need to replace that message routine with the routine that copies the data, but I don't know how to do that part.

Here's my code:

Sub LoopThroughFiles()
  Dim MyObj As Object, MySource As Object, file As Variant
  file = Dir("C:\Users\m10647\Desktop\Input timecard worksheets\")
  While (file <> "")
         MsgBox "found " & file
         file = Dir
  Wend
End Sub

Any help would be much appreciated.

 

[Deepak]

Hi,

You want something like this...

Sub LoopThroughFiles()
  Dim file As String, filename  As String
  Dim myfile As Workbook, ws As Worksheet
  file = "C:\Users\m10647\Desktop\Input timecard worksheets\"
  filename = Dir(file & "*.xlsx")
  While filename <> ""
        Set myfile = Workbooks.Open(file & filename)
        Set ws = ActiveSheet
         'what to do
        ws.Parent.Close False
    filename = Dir()
  Wend
Set ws = Nothing
Set myfile = Nothing
MsgBox "Done"
End Sub

For more..Share the sample file along with master.

 

[glennpc]

Deepak: Thank you for the reply! While I was waiting for a reply, I tried to adopt an approach I found on YouTube. I'm still trying to do the same thing-- and the video seemed to do exactly what I wanted to do (copy specific row from multiple worksheets into rows on my master worksheet) and in the video it worked fine. I have two things different than the video-- the positioning and amount of my data on the sheets (I don't begin everything in "A1") and my master file has the data in an Excel Table rather than a simple range. The code looks like this:

Sub LoopThroughDirectory()
 Dim MyFile As String
 Dim erow
 Dim Filepath As String
 Filepath = "C:\Users\m10647\Desktop\Timecards\"
 MyFile = Dir(Filepath)
 Do While Len(MyFile) > 0
  If MyFile = "zzMaster IPSS Weekly Time Sheet.xlsm" Then
  Exit Sub
  End If
 
  Workbooks.Open (Filepath & MyFile)
  Range("E14:K14").Copy
  ActiveWorkbook.Close
 
  erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 2), Cells(erow, 8))
 
  MyFile = Dir
 
 Loop
 End Sub

When I step through, Excel doesn't seem to like the line where I have erow = Sheet1.Cells(...

I'm testing with two input files in my "Timecards" folder on my desktop. The Master file is also in that folder and starts with zz so it comes last in the looping. I'm uploading both input files and the master file which contains the VBA code.

-Glenn

 

[Deepak]

As my approach....

Sub LoopThroughFiles()
  Dim file As String, filename  As String
  Dim myfile As Workbook, ws As Worksheet
  Dim tws As Worksheet, lastrow As Long
  Application.ScreenUpdating = False
  Set tws = ActiveSheet
  lastrow = tws.Cells(Rows.Count, 2).End(xlUp).Row
  file = "C:\Users\m10647\Desktop\Timecards\"
  filename = Dir(file & "*.xlsx")
  While filename <> ""
        Set myfile = Workbooks.Open(file & filename)
        Set ws = ActiveSheet
            ws.Range("E14:K14").Copy
            tws.Cells(lastrow + 1, 2).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        ws.Parent.Close False
    lastrow = lastrow + 1
    filename = Dir()
  Wend
Set ws = Nothing
Set myfile = Nothing
set tws = Nothing
Application.ScreenUpdating = True
End Sub

 

[Deepak]

Deepak: Thank you for the ..........
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 2), Cells(erow, 8))

MyFile = Dir

Loop
End Sub
[/CODE]

When I step through, Excel doesn't seem to like the line where I have erow = Sheet1.Cells(...

I'm testing with two input files in my "Timecards" folder on my desktop. The Master file is also in that folder and starts with zz so it comes last in the looping. I'm uploading both input files and the master file which contains the VBA code.

-Glenn

In this....
your are closing the file before pasting the values.

 

[glennpc]

This is some great code you wrote! Much appreciated. I see that you also pasted over the VALUES, instead of the formulas that are in some of the cells in the input sheets.

This is a great start. I have to make some adjustments to it-- it seems to ignore the first blank row of my table--it starts putting data in the row below it, and the new rows of data are not inside the table. I think maybe I can start with my sheet not having a table and then at the end of the code you wrote (which puts the data beginning in the row just below the header), add some new code to turn the results into a table, and then turn on the Total Row.

Thanks for your help!

Glenn