capture specific records from multiple sheets to one sheet

[syed_iqbal]

Hi,


I wrote a code, to capture all leavers (employees who "left the company")from 4 sheets and paste at one place (sheet("TS").range("M2")). but code is not working properly. Pls help



regards
shiva

[Paul_Hossler]

One thing is that the .Name is "AP2" and "AP1" etc.

If ws.Name = "Sheet4" Then
lr = lr1
ElseIf ws.Name = "Sheet3" Then
lr = lr2
ElseIf ws.Name = "Sheet2" Then
lr = lr3
ElseIf ws.Name = "Sheet1" Then
lr = lr4
End If

You can simplify things a little if you want. I think this is what you were doing

Option Explicit

Sub TEAMUDPATE()

    Dim rSummary As Range, rData As Range
    Dim wsTS As Worksheet, ws As Worksheet
    Dim iRowIn As Long, iRowOut As Long
    
    Set wsTS = Worksheets("TS")
    Set rSummary = wsTS.Cells(1, 13).CurrentRegion
    With rSummary
        If .Rows.Count > 1 Then
            .Cells(2, 1).Resize(.Rows.Count - 1, .Columns.Count).ClearContents
        End If
    End With
    
    iRowOut = 2
    
    For Each ws In ActiveWorkbook.Worksheets
        Set rData = ws.Cells(1, 1).CurrentRegion
        
        With rData
            For iRowIn = .Rows.Count To 2 Step -1
                If .Cells(iRowIn, 11).Value = "Left the Company" Then
                    .Rows(iRowIn).Copy
                    wsTS.Cells(iRowOut, 13).PasteSpecial xlPasteValues
                    .Rows(iRowIn).Delete
                    iRowOut = iRowOut + 1
                End If
            Next iRowIn
        End With
    Next
End Sub

The S.No field is recalucated after the delete since it is a formula