Sayfa kopyalama

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Ekli dosyadaki Ogretmen sayfasında
A2 hücresinde yazılı sayfa adını A3-A21 arasındaki isimlerle,
A22 hücresinde yazılı sayfa adını A23-A41 arasındaki isimlerle kopyalamak istiyorum.
Yanlış hatırlamıyorsam

Sub SyfKopyala()
    Dim Sayfa As Worksheet
    Dim SayfaAdi As String
    Dim SyfAd As String
    SyfAd = Range("A2").Text
    
            For Each Sayfa In Worksheets
                If Sayfa.Name = SayfaAdi Then
                    MsgBox "Bu isimde bir sayfa bulunmaktadır."
                    Exit Sub
                End If
            Next Sayfa
        Sheets.Add.Name = SayfaAdi
        Sheets(SayfaAdi).Move After:=Sheets(Sheets.Count)
    
        Sheets(SyfAd).Range("A:IV").Copy Sheets(SayfaAdi).Range("A1")
    Sheets("Ogretmen").Activate
    Range("D2").Select
End Sub

Hüseyin Hocamın çalışmasıydı. Ama istediğime uyarlayamadım, yardımcı olursanız sevinirim.
Saygılarımla

 

[Tevfik_Kursun]

Merhaba Arkadaşlar,

Sub SyfKopyala()
    Dim Sayfa As Worksheet
    Dim SayfaAdi As String
    Dim SyfAd As String
    
    SnfSys = 20 - 1
        For x = 1 To SnfSys
            Sheets("Ogretmen").Activate
            SyfAd = Range("A2").Text
            SayfaAdi = Cells(2 + x, 1).Text
            Sheets.Add.Name = SayfaAdi
            Sheets(SayfaAdi).Move After:=Sheets(Sheets.Count)
            Sheets(SyfAd).Range("A:IV").Copy Sheets(SayfaAdi).Range("A1")
        Next
            SyfAd = ""
        For y = 1 To SnfSys
            Sheets("Ogretmen").Activate
            SyfAd = Range("A" & 3 + SnfSys).Text
            SayfaAdi = Cells(3 + SnfSys + y, 1).Text
            Sheets.Add.Name = SayfaAdi
            Sheets(SayfaAdi).Move After:=Sheets(Sheets.Count)
            Sheets(SyfAd).Range("A:IV").Copy Sheets(SayfaAdi).Range("A1")
        Next
    Sheets("Ogretmen").Activate
    Range("D2").Select
End Sub

Makroyu bu hale getirip kopyalamayı tamamladım.
Hepinize teşekkür ederim.
Saygılarımla