Verilerin diğer sayfalara aktarılması

[headspring]

Selam arkadaşlar,
Excelde bir konuda yardımınıza ihtiyacım var ve ben bir yol bulamadım.
İlişikteki dosyada NTP isimli sayfaya girdiğim verilerin ilgili AHB sayfalarına aktarmak istiyorum.NTP sayfasında B sütununa göre 1nolu AHB ye ait tüm bilgilerin 1AHB sayfasına,2 ile ilgili olanlar 2AHB ye aktarmalı.Bir veri olsa bunu düşeyara formülü ile hallediyordum ama birden fazla olunca işin içinden çıkamadım.İstediğim gibi yapabilmemi sağlamak için hangi formülü kullanmam gerekir.Yardımı olacak bir yol göstereceklere teşekkür ederim.

https://drive.google.com/file/d/0B-ikjCYWoiuTdjEwaXVmb1Itcjg/view?usp=sharing

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Link:

http://s3.dosya.tc/server3/eywv0k/headspring-NTP_deneme.zip.html

 

[headspring]

Emeğine sağlık,teşekkür ederim.

​

 

[headspring]

Sub SayfaAktar()
Dim i, j As Long, Sayfa As String, S1 As Worksheet
Set S1 = Sheets("NTP")
Application.ScreenUpdating = False
For j = 2 To Worksheets.Count
    Sheets(j).Cells.Delete Shift:=xlUp
Next j
For i = 2 To S1.[A65536].End(3).Row
    Sayfa = Cells(i, "A")
        If Not SayfaVarMi(Sayfa) Then
            Sheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Sayfa
            S1.Select
        End If
    S1.Range("B1").Copy Sheets(Sayfa).Range("A1")
    S1.Range("K1").Copy Sheets(Sayfa).Range("B1")
    S1.Range("L1").Copy Sheets(Sayfa).Range("C1")
    S1.Range("M1").Copy Sheets(Sayfa).Range("D1")
    S1.Range("N1").Copy Sheets(Sayfa).Range("E1")
    S1.Range("P1").Copy Sheets(Sayfa).Range("F1")
    S1.Range("B" & i).Copy Sheets(Sayfa).Range("A" & Sheets(Sayfa).[A65536].End(3).Row + 1)
    S1.Range("K" & i).Copy Sheets(Sayfa).Range("B" & Sheets(Sayfa).[B65536].End(3).Row + 1)
    S1.Range("L" & i).Copy Sheets(Sayfa).Range("C" & Sheets(Sayfa).[C65536].End(3).Row + 1)
    S1.Range("M" & i).Copy Sheets(Sayfa).Range("D" & Sheets(Sayfa).[D65536].End(3).Row + 1)
    S1.Range("N" & i).Copy Sheets(Sayfa).Range("E" & Sheets(Sayfa).[E65536].End(3).Row + 1)
    S1.Range("P" & i).Copy Sheets(Sayfa).Range("F" & Sheets(Sayfa).[F65536].End(3).Row + 1)
    Sheets(Sayfa).Range("A:P").EntireColumn.AutoFit
Next i
Set S1 = Nothing
Application.ScreenUpdating = True
End Sub

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

Bu konuyla ilgili bir makroyu kendime göre uyarladım.İstediğim gibi istenen verileri yeni sayfalara taşıdım.
Ama şöyle bir sorun var.K-L-M-N sütünlarının tamamına veri girişi yaparsam sorun olmuyor ancak birkaç tanesine veri girince aktarmada sorun oluyor,bir kısmını aktarmıyor ki bu sütunlarda birkaçtane veri giriyorum.Makro konusundan fazla anlamadığım için kodun neresinde yanlış yaptığımıda bulamadım.
Bu konuda bilgisi olan üstadların yardıma ihtiyacım var.

https://drive.google.com/file/d/0B-ikjCYWoiuTU0NYTV9NNXNBU2M/view?usp=sharing