Veri girişi sayfasından diğer sayfalara kritere göre veri aktarımı

[alugator]

Selamlar,
Ekteki dosyada giriş sayfasında A sütunundaki verileri C6 hücresindeki değere göre diğer sayfalara aktarması için yardımlarınıza ihtiyacım var.
Teşekkür ederim.

 

[Necdet]

Merhaba,

Sayfa Adı kontrolü yaparak aktarır.

Sub Aktar()
Dim i       As Long
Dim SonSat  As Long
Dim s1      As Worksheet
Dim s2      As Worksheet
Dim Sayfa   As String
Set s1 = Sheets("GİRİŞ")
s1.Select
SonSat = [A65536].End(3).Row
If SonSat < 6 Then SonSat = 6
Application.ScreenUpdating = False
For i = 6 To SonSat
    Sayfa = Trim(Cells(i, "A"))
    If Not SayfaVarMi(Sayfa) Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Sayfa
        s1.Select
    End If
    
    Sheets(Sayfa).Cells([C6], "B") = Cells(i, "B")
    
Next i
Application.ScreenUpdating = True
MsgBox "Aktarılmıştır..."
End Sub

Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

 

[Orion1]

Dosyanız ektedir.

Sub kaydet()
Dim i As Long
On Error Resume Next
Sheets("GİRİŞ").Select
For i = 6 To Cells(65536, "A").End(xlUp).Row
    Sheets(CStr(Cells(i, "A").Value)).Range("B" & _
    Cells(6, "C").Value) = Cells(i, "B").Value
Next
MsgBox "Veriler sayfalara aktarıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[alugator]

Teşekkür ederim sayın Evren gizlen ve Sayın Necdet Yeşertener

 

[Orion1]

Teşekkür ederim sayın Evren gizlen ve Sayın Necdet Yeşertener

Rica ederim.
İyi çalışmalar.