macro behaving erratically

[Robert E Lee]

Hi

I have 2 workbooks, one with 25 sheets each relevant to a particular project and a second containing recently received invoices.

Certain parts of the information of these invoices are to be copied to the relevant project sheet.

Each project sheet has a number of nominal codes (there are between 1 and 9 of these codes.

I have created the macro below which is behaving oddly in that if I step through it it does what is required, if I run it sometimes no details are returned and sometimes the detail relevant to the first sheet is repeated for all other sheets.

In between these runs no change is made to the macro and it is always started from the beginning so no residual values are stored.

Any help appreciated

For Each Ds In Wb.Sheets
           
                                If Ds.Name <> "Sheet1" Then
                                Range("A2").Select
                                          i = Ds.Cells.Find(What:="", After:=ActiveCell, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
                                                    False, SearchFormat:=False).Row                              
 N = i - 3
 R = Ds.Cells(Rows.Count, 1).End(xlUp).Row + 1
 If N = 0 Then
 
Set BRange = Range("A2")
Else
Set BRange = Range("A2", "A" & i - 1)
End If
Wb2.Activate
Range("D2").Select

Set TRange = Range(ActiveCell, ActiveCell.Offset(R1, 0))

For Each Cell In BRange


                               For Each C In TRange
                                           If C = Cell Then
                                           
                                           Set S = Range(C.Offset(0, -2), (C.Offset(0, 3)))
                                           
                                           SRange.Copy Destination:=Ds.Range("A" & R)
                                           R = R + 1
                                           End If
                
                               Next C

                Next Cell

End If

Thanks

Rob

 

[Norie]

Rob

You need worksheet references for the ranges you are referring to in the code.

Give this a try.

For Each Ds In Wb.Sheets

    
    If Ds.Name <> "Sheet1" Then
    
        i = Ds.Cells.Find(What:="", After:=Ds.Range("A2"), SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Row
        
        N = i - 3
        
        R = Ds.Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        If N = 0 Then
            Set BRange = Ds.Range("A2")
        Else
            Set BRange = Ds.Range("A2:A" & i - 1)
        End If
                            
        With wb2.ActiveSheet
        
            Set TRange = .Range(.Ramge("D2"), .Range("D2").Offset(R1, 0))
        
        End With
        
        For Each Cell In BRange
            
            
            For Each C In TRange
            
                If C = Cell Then
                    
                    Set S = Range(C.Offset(0, -2), (C.Offset(0, 3)))
                    
                    SRange.Copy Destination:=Ds.Range("A" & R)
                    
                    R = R + 1
                End If
            
            Next C
        
        Next Cell
    
    End If

 

[Robert E Lee]

Thank you so much, Norie so obvious when you think about it, which I clearly didn't

Regards

Rob