Veri aktarımda oluşan hata

[Ledaer]

Merhabalar,
ekteki dosyada üç tane sayfa vardır. Mor - Müşteri - Programlama adında. Progralama sayfasından diğer 2 sayfadaki seçilen bazı değerleri aktarma yapılmaktadır. Aktarma için 2 tane seçenek vardır. 1. seçenek sayfa seçimi ( ya 2 sayfa yada tek sayfadan ) 2.seçenek ise işlem seçimidir. Sayfa seçimini hepsi seçince istenilen değerler aktarılmaktadır ama örneği mor yada müşteri gibi tek sayfa seçince hata vermektedir. dosyada belirttim. Yardımcı olursanız sevirim.
Teşekkürler.

 

[Ayhan Ercan]

Merhaba,,

Aşağıdaki kodda kırmızı olan yerleri değiştirerek tekrar denermisniz... ?

Sub AKTAR()
    Dim ALAN As Range
    Set SR = Sheets("Programlama")
    SR.Select
    SATIR = 8
    [a8:I65536].ClearContents
    If [B3] = "" Then: MsgBox "LÜTFEN SAYFA SEÇİMİ YAPINIZ !", vbExclamation, "DİKKAT !": [B3].Select: Exit Sub
    If [B4] = "" Then: MsgBox "LÜTFEN İŞLEM SEÇİMİ YAPINIZ !", vbExclamation, "DİKKAT !": [B4].Select: Exit Sub
        If [B3] = "HEPSİ" Then
            For X = 1 To Sheets.Count - 1
                For Each ALAN In Sheets(X).Range("N5:U65536").SpecialCells(xlCellTypeConstants, 23)
                    If UCase(ALAN.Value) = [C4] Then
                    Cells(SATIR, 1) = Sheets(X).Cells(ALAN.Row, 1) 'Parti No'
                    Cells(SATIR, 2) = Sheets(X).Cells(ALAN.Row, 3) ' Firma '
                    Cells(SATIR, 3) = Sheets(X).Cells(ALAN.Row, 5) ' Tip '
                    Cells(SATIR, 4) = Sheets(X).Cells(ALAN.Row, 6) ' Kumaş Kalitesi '
                    Cells(SATIR, 5) = Sheets(X).Cells(ALAN.Row, 7) ' Renk '
                    Cells(SATIR, 6) = Sheets(X).Cells(ALAN.Row, 8) ' Metre '
                    Cells(SATIR, 7) = Sheets(X).Cells(ALAN.Row, 11) ' Yapılan İşlem '
                    Cells(SATIR, 8) = Sheets(X).Cells(ALAN.Row, 12) ' İşlem Saati '
                    Cells(SATIR, 9) = Sheets(X).Cells(ALAN.Row, 13) ' Sıradaki İşlem '
                    SATIR = SATIR + 1
                    End If
                Next
            Next
        Else
    For Each ALAN In Sheets([B3].Text).Range("N5:U65536").SpecialCells(xlCellTypeConstants, 23)
    If UCase(ALAN.Value) = [C4] Then
    Cells(SATIR, 1) = Sheets[COLOR=red][B]([B3].Text).[/B][/COLOR]Cells(ALAN.Row, 1) 'Parti No'
    Cells(SATIR, 2) = Sheets[B][COLOR=red]([B3].Text)[/COLOR][/B].Cells(ALAN.Row, 3) ' Firma '
    Cells(SATIR, 3) = Sheets[COLOR=red][B]([B3].Text)[/B][/COLOR].Cells(ALAN.Row, 5) ' Tip '
    Cells(SATIR, 4) = Sheets[B][COLOR=red]([B3].Text)[/COLOR][/B].Cells(ALAN.Row, 6) ' Kumaş Kalitesi '
    Cells(SATIR, 5) = Sheets[COLOR=red][B]([B3].Text)[/B][/COLOR].Cells(ALAN.Row, 7) ' Renk '
    Cells(SATIR, 6) = Sheets[COLOR=red][B]([B3].Text)[/B][/COLOR].Cells(ALAN.Row, 8) ' Metre '
    Cells(SATIR, 7) = Sheets[COLOR=red][B]([B3].Text)[/B][/COLOR].Cells(ALAN.Row, 11) ' Yapılan İşlem '
    Cells(SATIR, 8) = Sheets[COLOR=red][COLOR=black]([/COLOR][B][B3].Text[/B][/COLOR][COLOR=black])[/COLOR].Cells(ALAN.Row, 12) ' İşlem Saati '
    Cells(SATIR, 9) = Sheets([COLOR=red][B][B3].Text[/B][/COLOR]).Cells(ALAN.Row, 13) ' Sıradaki İşlem '
    SATIR = SATIR + 1
    End If
    Next
    End If
    MsgBox "AKTARIM İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[Ledaer]

evet sorunsuz çalışıyor çok teşekkür ederim.
bir sorumda daha olacaktı, bu aktarım işlemi yaptıktan sonra o değerleri başka sayfaya aktarımı, örneğin 8 tanede daha sayfa ekledim. 3 nolu sayfayı seçip aktarma işlemi için nasıl yapabilirim.

teşekkürler.

 

[Ayhan Ercan]

evet sorunsuz çalışıyor çok teşekkür ederim.
bir sorumda daha olacaktı, bu aktarım işlemi yaptıktan sonra o değerleri başka sayfaya aktarımı, örneğin 8 tanede daha sayfa ekledim. 3 nolu sayfayı seçip aktarma işlemi için nasıl yapabilirim.

teşekkürler.

Merhaba,

istediğiniz kadar sayfa ekleyin. Sayfa adını B3 hücresine girip AKTAR deyince istediğiniz gerçekleşecektir. ekstradan ilave edilecek bir kod yoktur.

HEPSİ denince nekadar sayfa varsa hepsine aktarma yapar..

 

[Ledaer]

Merhaba,

istediğiniz kadar sayfa ekleyin. Sayfa adını B3 hücresine girip AKTAR deyince istediğiniz gerçekleşecektir. ekstradan ilave edilecek bir kod yoktur.

HEPSİ denince nekadar sayfa varsa hepsine aktarma yapar..

çok teşekkür ederim.
selamlar.

 

[Ayhan Ercan]

çok teşekkür ederim.
selamlar.

Rica ederim.
İyi çalışmalar....

 

[Ayhan Ercan]

Merhaba,

istediğiniz kadar sayfa ekleyin. Sayfa adını B3 hücresine girip AKTAR deyince istediğiniz gerçekleşecektir. ekstradan ilave edilecek bir kod yoktur.

HEPSİ denince nekadar sayfa varsa hepsine aktarma yapar..

Not: Şunun bilinmesi lazım: Kod içerisinde kurulan döngünün sayfa sıra numaralarını dikkate aldığı için, veri aktarmada hata oluşmaması adına, "Programlama" sayfası herzaman en son sayfa olması lazım.

Veya;
"Programlama" sayfasını en başa (ilk sayfa) alıp
For X = 1 To Sheets.Count - 1 kodunu
For X = 2 To Sheets.Count olarak değiştirmek lazım.