delete rows in the sheets

[Mergh06]

Hello guys,

In the attached file, I need to delete the rows in alle sheets if the same number in column A's not appears in alle the sheets. In other words, if there is a number "1" in coloumn A sheet 1, and theres is no "1" in column A sheet 2, then delete row with "1" in sheet 1.

in the attached example you will be left with numbers 2,4,5,7 with their values in column B in all the sheets
I would really appreciate some help

[mikerickson]

In the attached, I've added identical headers to each column so that the Advanced Filter can work.

This routine iterates the idea that if you have two lists with the same header, AdvancedFilter, with one as the Data Range and the other as the criteria range, the result will be those items in common.
[VBA]Sub test()
Dim SheetsToCompare As Object
Dim sheetNo As Long
Dim sourceRange As Range, critRange As Range, destRange As Range
Dim destinationRange As Range

Set SheetsToCompare = ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")): Rem adjust

With SheetsToCompare
With .Item(1).Range("A:A")
Set destRange = Range(.Cells(1, 2), .Cells(.Rows.Count, 1).End(xlUp))
End With
For sheetNo = 1 To SheetsToCompare.Count - 1
Set sourceRange = destRange.CurrentRegion

With .Item(sheetNo + 1)
Set destRange = .UsedRange.Offset(0, .UsedRange.Columns.Count + 1)
With .Columns(1)
Set critRange = Range(.Cells(1, 2), .Cells(.Rows.Count, 1).End(xlUp))
End With
End With
sourceRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critRange, CopyToRange:=destRange, Unique:=False
sourceRange.ClearContents

MsgBox sourceRange.Address(, , , True) & vbCr & critRange.Address(, , , True) & vbCr & destRange.Address(, , , True)
Next sheetNo
critRange.ClearContents
critRange.Resize(destRange.Rows.Count, destRange.Columns.Count).Value = destRange.Value
destRange.CurrentRegion.ClearContents

.FillAcrossSheets critRange.EntireColumn, xlFillWithContents
End With
End Sub[/VBA]