View Full Version : capture specific records from multiple sheets to one sheet

04-02-2017, 04:09 PM

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


04-02-2017, 06:06 PM
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


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
wsTS.Cells(iRowOut, 13).PasteSpecial xlPasteValues
iRowOut = iRowOut + 1
End If
Next iRowIn
End With
End Sub

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