Loop through many workbooks, loop through only the first and second worksheets, then copy/paste cells into a workbook

0
votes

"New VBA user, Excel 2010, and I have several cost estimate workbooks within same folder. Within a separate summary workbook I want to loop through all workbooks, then loop through only the first and second worksheets, then copy and final paste values of specific cells.

I have pieced together certain snippets from several sources in the below. Currently only the first "If" loop for worksheet "Distro Sheet" seems to be grabbing data. The second "If" loop for "Execution Estimate" never seems to paste any cells? I have tried flagging the first two worksheets, used an array, and used a "Case" statement. None of these methods worked. Any ideas would be greatly appreciated!"

Sub GatherData()

Dim wkbkorigin As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet

Dim ResultRow As Long
Dim Fname As String
Dim RngDest As Range
Dim ws As Worksheet

Set destsheet = ThisWorkbook.Worksheets("Project Cost Tracker")
Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).EntireRow
Fname = Dir(ThisWorkbook.Path & "/*.xlsx")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While Fname <> "" And Fname <> ThisWorkbook.Name
 Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)

        For Each ws In wkbkorigin.Worksheets

                    If ws.Name = "Distro Sheet" Then

                        RngDest.Cells(6, 1).Value = ws.Range("C8").Value
                        RngDest.Cells(6, 5).Value = ws.Range("H8").Value
                        RngDest.Cells(5, 2).Value = ws.Range("C10").Value
                        RngDest.Cells(7, 1).Value = ws.Range("C15").Value
                        RngDest.Cells(8, 1).Value = ws.Range("C16").Value
                        RngDest.Cells(9, 1).Value = ws.Range("C17").Value
                        RngDest.Cells(10, 1).Value = ws.Range("C18").Value
                        RngDest.Cells(11, 1).Value = ws.Range("C19").Value
                        RngDest.Cells(7, 5).Value = ws.Range("D20").Value
                        RngDest.Cells(8, 5).Value = ws.Range("D21").Value
                        RngDest.Cells(9, 5).Value = ws.Range("D22").Value
                        RngDest.Cells(10, 5).Value = ws.Range("D23").Value
                        RngDest.Cells(11, 5).Value = ws.Range("D24").Value

                    End If

                    If ws.Name = "Execution Estimate" Then

                        RngDest.Cells(8, 10).Value = ws.Range("J99").Value
                        RngDest.Cells(9, 10).Value = ws.Range("J157").Value
                        RngDest.Cells(10, 10).Value = ws.Range("J186").Value

                    End If

         Set RngDest = RngDest.Offset(1, 0)

       Next ws

 wkbkorigin.Close SaveChanges:=False
 Fname = Dir()

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
2
excelexcel-2010vba
Have you tried stepping through line by line with the debugger? – SandPiper
@SandPiper Yes, variable ws runs through each sheet as it should but on sheet #2 "Execution Estimate" none of the values populate my summary workbook. Seems there is a better way of stepping through only select worksheets rather than all? Thanks for feedback! – A. Staton73
What is the value of ws.Name when you get to the second sheet? Is it "Execution Estimate" (exact case, no extra spaces, exact spelling)? (i.e. when you step through the code, does it actually step into the second If statement?) – YowE3K
I see now that when evaluating the If statement for "Execution Estimate" is not being evaluated. It simple skips over. I am running multiple sample workbooks and they each have the second worksheet spell out exactly "Execution Estimate". I also tried "Execution* " to no success. – A. Staton73
You both are awesome @SandPiper and @YowE3K! The "Execution Estimate" had a extra space at the tail end. Code works perfectly in Excel 2016 from home. Thanks and have a great weekend! Corrected code is below.. – A. Staton73

2 Answers

0
votes

Here is the corrected code.. and lesson learned to use the debugger and track the significant variables. 

    Sub GatherData()

         Dim wkbkorigin As Workbook
         Dim originsheet As Worksheet
         Dim destsheet As Worksheet

         Dim ResultRow As Long
         Dim Fname As String
         Dim RngDest As Range
         Dim ws As Worksheet

         Set destsheet = ThisWorkbook.Worksheets("Project Cost Tracker")
         Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).EntireRow
         Fname = Dir(ThisWorkbook.Path & "/*.xlsx")

         Application.ScreenUpdating = False
         Application.DisplayAlerts = False

         Do While Fname <> "" And Fname <> ThisWorkbook.Name
         Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)

         For Each ws In wkbkorigin.Worksheets

                    If ws.Name = "Distro Sheet" Then

                        RngDest.Cells(6, 1).Value = ws.Range("C8").Value
                        RngDest.Cells(6, 5).Value = ws.Range("H8").Value
                        RngDest.Cells(5, 2).Value = ws.Range("C10").Value
                        RngDest.Cells(7, 1).Value = ws.Range("C15").Value
                        RngDest.Cells(8, 1).Value = ws.Range("C16").Value
                        RngDest.Cells(9, 1).Value = ws.Range("C17").Value
                        RngDest.Cells(10, 1).Value = ws.Range("C18").Value
                        RngDest.Cells(11, 1).Value = ws.Range("C19").Value
                        RngDest.Cells(7, 5).Value = ws.Range("D20").Value
                        RngDest.Cells(8, 5).Value = ws.Range("D21").Value
                        RngDest.Cells(9, 5).Value = ws.Range("D22").Value
                        RngDest.Cells(10, 5).Value = ws.Range("D23").Value
                        RngDest.Cells(11, 5).Value = ws.Range("D24").Value

                    End If

                    If ws.Name = "Execution Estimate " Then

                        RngDest.Cells(8, 10).Value = ws.Range("J99").Value
                        RngDest.Cells(9, 10).Value = ws.Range("J157").Value
                        RngDest.Cells(10, 10).Value = ws.Range("J186").Value

                    End If

         Set RngDest = RngDest.Offset(1, 0)

       Next ws

    wkbkorigin.Close SaveChanges:=False
   Fname = Dir()

   Loop

   Application.ScreenUpdating = True
   Application.DisplayAlerts = True

   End Sub
0
votes

So, just the 1st and second sheet, right?

wks.Index = 1
wks.Index = 2

The code should look something like this . . .

objXL.Visible = True
Set wkb = objXL.Workbooks.Open(strPathFile)
For Each wks In wkb.Worksheets
    If wks.Index = 1 or wks.Index = 2 Then
        NeedThisSheet = wks.Name & "!"
        ' THIS IS FOR IMPORTING DATA INTO ACCESS
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames, NeedThisSheet
    End If
Next
wkb.Close