Sub Demo1()
Dim S&
Application.ScreenUpdating = False
With Sheet1.[A1].CurrentRegion
.Range("K1") = .Range("C1")
For S = 2 To Worksheets.Count
Worksheets(S).UsedRange.Clear
.Range("K2") = Worksheets(S).Name
.AdvancedFilter 2, .Range("K1:K2"), Worksheets(S).[A1]
Next
.Range("K1:K2").Clear
End With
Application.ScreenUpdating = True
End Sub