DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub aktar()
Dim x As Long
x = 0
Dim rng As Range
Set rng = Sheets("Liste").Range("A1")
For Each sayfa In Worksheets
If Not sayfa.Name = "Liste" Then
rng.Offset(x, 0).Value = sayfa.Name
rng.Offset(x, 1).Value = sayfa.Range("a3").Value
x = x + 1
End If
Next sayfa
End Sub