Açılan sayfaları sil

[nadirornek]

Merhaba

Sayfalara aktar makro çalışıyor.Bu makroyu çalıştırınca yeni sayfalar açılarak veriler aktarılıyor.
İki makroya ihyacım var.

1-Açılan yeni sayfalardaki A1 ve F1 hücrelerindeki verilerin Ana Sayfada A1 ve B1 hücrelerinden alt alta yazması.
2-Açılan yeni sayfaların silinmesi.

 

[nadirornek]

Option Explicit

Sub SAYFALAR_SİL()

Dim Sayfa As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> "Rapor" And Sayfa.Name <> "Sayfa1" And Sayfa.Name <> "Sayfa2" And Sayfa.Name <> "Sayfa3" And Sayfa.Name <> "Ana Sayfa" And Sayfa.Name <> "Rapor" Then Sayfa.Delete
Next


Application.ScreenUpdating = True

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Bu kod ile açılan yeni Sayfaları sildim.
1-sorum kaldı

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub ANA_SAYFAYA_AKTAR()
    Dim Sayfa As Worksheet, Satır As Integer
    
    Application.ScreenUpdating = False
    
    Sheets("Ana Sayfa").Range("A:B").ClearContents
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If InStr(1, Sayfa.Name, "Parça ") > 0 Then
            Satır = Satır + 1
            Sheets("Ana Sayfa").Cells(Satır, "A") = Sayfa.Range("A1")
            Sheets("Ana Sayfa").Cells(Satır, "B") = Sayfa.Range("F1")
        End If
    Next
    
    Sheets("Ana Sayfa").Select
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[nadirornek]

Korhan bey teşekkürler şimdi oldu .Dosyaya ekledim.İyiki varsın.

 

[nadirornek]

Korhan bey,
Aşağıdaki kodun If ile başlayan satıra ekleme sayfa isimleri girdiğim zaman değim sonu diye hata uyarısı veriyor.Bir alt satıra geçmem için ıf satırının sonuna ne ekleyip alt satıra geçebilirim.If satırı kırmızı renk alıyor.En az 80 sayfa ismi yazmam gerekiyor.
Option Explicit

Sub SAYFALAR_SİL()

Dim Sayfa As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> "Rapor" And Sayfa.Name <> "Sayfa1" And Sayfa.Name <> "Sayfa2" And Sayfa.Name <> "Sayfa3" And Sayfa.Name <> "Ana Sayfa" And Sayfa.Name <> "Rapor" Then Sayfa.Delete
Next


Application.ScreenUpdating = True

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub