Makro ile tüm sayfaları silme

[Serdarrk]

Merhaba arkadaşlar,

Ekte bulunan excel dosyasında 30'dan fazla sayfa bulunmakta. Benim amacım bunların yanında bir sayfa açıp bir kaç bilgiyi ona aktarıp geri kalanı silerek yüzlerce dosyayı temizlemek. Ancak makro diğer dosyalarda bu 30'dan fazla sayfanın ismi değişebildiği için çalışmamakta. Makro ile sadece belirlediğim sayfayı bırakıp diğer sayfaların adı değişse de tamamını silebilmem mümkün müdür?

http://s7.dosya.tc/server3/ie7cb5/01-Agu-2014-1.xls.html

 

[AdemCan]

Merhaba,
Örnek olarak şu kod ile sayfaları silebilirsiniz.

Sub sayfaları_sil()
For x = Sheets.Count To 1 Step -1
If Sheets(x).Name = "[COLOR="Red"]Sayfa1[/COLOR]" Then Exit Sub
Application.DisplayAlerts = False
Sheets(x).Delete
Next
End Sub

Kırmızı ile işaretli olan Sayfa1 yerine, silinmesini istemediğiniz Sayfanın Adını yazıp; bu sayfayı, sekme sırasında ilk sıraya getiriniz. Sayfa1 ismine gelene kadar tüm sayfaları siler ve Sayfa1 isminde makro durur.

 

[Serdarrk]

İlginiz ve cevabınız için teşekkür ederim.Verdiğiniz kodla denedim ancak ilk dosyadan sonra diğer dosyalarda çalıştırmayı beceremedim. Aşağıdaki kodlar silme işlemine gelmeden hemen önceye kadar yapmam gereken işlemler.Sizden ricam verdiğiniz kodu bu kodlarla birlikte çalışacak halde tekrar gönderebilir misiniz? Ve ya isterseniz makroyu çalıştırıp silme işlemine gelene kadar kaydedip dosyayı makrolu halde buraya yükleyeyim.

Sub Makro1()
'
' Makro1 Makro
'
' Klavye Kısayolu: Ctrl+ÜstKrkt+R
'
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("N1- 1").Select
    Rows("12:108").Select
    Selection.Copy
    Sheets("Sayfa1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=84
    Sheets("N1- 2").Select
    Rows("14:108").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("A98").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=12
    Sheets("N1- 3").Select
    Rows("14:80").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    ActiveWindow.SmallScroll Down:=84
    Range("A193").Select
    ActiveSheet.Paste
    Sheets("Sayfa1").Select
    Application.CutCopyMode = False
    Sheets("Sayfa1").Move Before:=Sheets(1)
    Application.Goto Reference:="Makro1"
End Sub

 

[Serdarrk]

Deneyerek tamamladım işlemi. Çok teşekkür ederim büyük bir zaman kaybından kurtardınız beni.