For Each not looping through worksheets

[jtotman]

Hi!

I am trying to consolidate data from multiple workbooks into one sheet in workbook. For some reason, I cannot get excel to loop through those every sheet the workbook and copy the data. I am including my code below. Any suggestions would be appreciated!

Sub BOCIndex()


Workbooks.Open Filename:=ThisWorkbook.Path & "\BOC Cust.xlsx"


Dim LastRowRange As Long
Dim LastRowIndex As Long
Dim ws As Worksheet


For Each ws In ActiveWorkbook.Worksheets


LastRowRange = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
                    
LastRowIndex = Workbooks("Deposits Consolidation.xlsm").Worksheets("Index").Range("B1").End(xlDown).Row + 1






Range("A4", "D" & LastRowRange).Copy
Workbooks("Deposits Consolidation.xlsm").Worksheets("Index").Range("B" & LastRowIndex).PasteSpecial xlPasteValues


Next ws


'Workbooks("BOC Cust.xlsx").Close savechanges:=False


End Sub

 

[ranman256]

You have to activate the sheet....

for each ws in sheets
Ws.activate
....

 

[Osvaldo Palmeiro]

Hi. Try:

Sub BOCIndex()
 Dim LastRowRange As Long
 Dim LastRowIndex As Long
 Dim ws As Worksheet
  Workbooks.Open Filename:=ThisWorkbook.Path & "\BOC Cust.xlsx"
   For Each ws In ActiveWorkbook.Worksheets
    With ws
     LastRowRange = .Cells.Find(What:="*", _
     After:=.Range("A1"), _
     LookAt:=xlPart, _
     LookIn:=xlFormulas, _
     SearchOrder:=xlByRows, _
     SearchDirection:=xlPrevious, _
     MatchCase:=False).Row
     
     LastRowIndex = Workbooks("Deposits Consolidation.xlsm").Worksheets("Index").Range("B1").End(xlDown).Row + 1

      .Range("A4", "D" & LastRowRange).Copy
      Workbooks("Deposits Consolidation.xlsm").Worksheets("Index").Range("B" & LastRowIndex).PasteSpecial xlPasteValues
    End With
   Next ws
'Workbooks("BOC Cust.xlsx").Close savechanges:=False
End Sub

 

[jtotman]

Hi. Thank you both for your suggestions, but neither one seems to correct the problem. They both run without errors, but they only copy the first sheet of data while ignoring the subsequent sheets.

 

[RoryA]

Assuming the code is in the Deposits Consolidation workbook, try this:

Sub BOCIndex()
 Dim LastRowRange As Long
 Dim LastRowIndex As Long
 Dim wb as workbook
 Dim ws As Worksheet
 Dim wsIndex as Worksheet
set wsIndex = Thisworkbook.Worksheets("Index")

  Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\BOC Cust.xlsx")
   For Each ws In wb.Worksheets
    With ws
     LastRowRange = .Cells.Find(What:="*", _
     After:=.Range("A1"), _
     LookAt:=xlPart, _
     LookIn:=xlFormulas, _
     SearchOrder:=xlByRows, _
     SearchDirection:=xlPrevious, _
     MatchCase:=False).Row
    
     LastRowIndex = wsIndex.Cells(wsIndex.Rows.Count, "B").End(xlUp).Row + 1

      .Range("A4", "D" & LastRowRange).Copy
      wsindex.Range("B" & LastRowIndex).PasteSpecial xlPasteValues
    End With
   Next ws
'wb.Close savechanges:=False
End Sub

 

[jtotman]

Hi Rory,

Thank you so much! This works perfectly.

 

[RoryA]

Glad to help.