AccessTr.neT
Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak (/konu-sablonu-belirlenen-sayfalara-kopyalama-yontemi-ile-sartli-dagitmak.html)

Sayfalar: 1 2 3 4 5 6

RE: Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak - hayalibey - 22/11/2020

Sheetschange ve sheetsselectionchange bu kodları silip denedim
sicil sayfaları düzgün

isimler aynı anlayamadım

RE: Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak - feraz - 22/11/2020

(22/11/2020, 20:49)hayalibey yazdı: Sheetschange ve sheetsselectionchange bu kodları silip denedim
sicil sayfaları düzgün

isimler aynı anlayamadım
Son yolladığım dosyada hata var mı?

RE: Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak - hayalibey - 22/11/2020

Hocam onda liste sayfalarına dağıtıyor ama doğru dağıttığını orjinal dosyadan test edemedim
Hocam bağlantı mı kursak

RE: Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak - feraz - 22/11/2020

Kodlar aşağıda.Sub Listele() ve  Sub Siciller() arasındaki farkalr sadece şunlar.

Sub Listele() için
Kod:
Set bul = s2.Range("C:C").Find(s1.Cells(k, i).Value, , , 1)
For i = 16 To 25
Sub Siciller() için
Set bul = s2.Range("B:B").Find(s1.Cells(k, i).Value, , , 1)

For i = 27 To 29


Kod:
Sub Listele()
    Dim s1 As Worksheet, s2 As Worksheet, syfListe As Worksheet
    Dim i As Integer, bul As Range, son As Long, k As Long, say As Long
   
    Set s1 = ThisWorkbook.Sheets("KONTROL")
    Set s2 = ThisWorkbook.Sheets(Me.ComboBox2.Value)
   
    say = 7
    Application.ScreenUpdating = False
    For i = 16 To 25
        son = s1.Cells(Rows.Count, i).End(3).Row
        If son < 2 Then Exit For
        Set syfListe = ThisWorkbook.Sheets(s1.Cells(1, i).Value)
        syfListe.Range("A7:Aj" & Rows.Count).Clear
        syfListe.Range("A1:Z6").UnMerge
        s2.Range("A1:Z6").Copy syfListe.Range("A1")
        Application.CutCopyMode = False
        For k = 2 To son
            Set bul = s2.Range("C:C").Find(s1.Cells(k, i).Value, , , 1)
            If Not bul Is Nothing Then
                s2.Range("A" & bul.Row & ":Aj" & bul.Row).Copy syfListe.Cells(syfListe.Cells(Rows.Count, 1).End(3).Row + 1, 1)
                Application.CutCopyMode = False
            End If
        Next
        Rutbe_Sicil_Sirala2 syfListe.Name
        syfListe.Range("A:E").Columns.AutoFit
    Next
    Application.ScreenUpdating = True

    Set s1 = Nothing: Set s2 = Nothing: Set bul = Nothing: Set syfListe = Nothing

End Sub
Kod:
Sub Siciller()
    Dim s1 As Worksheet, s2 As Worksheet, syfListe As Worksheet
    Dim i As Integer, bul As Range, son As Long, k As Long, say As Long
   
    Set s1 = ThisWorkbook.Sheets("KONTROL")
    Set s2 = ThisWorkbook.Sheets(Me.ComboBox2.Value)
   
    say = 7
    Application.ScreenUpdating = False
    For i = 27 To 29
        son = s1.Cells(Rows.Count, i).End(3).Row
        If son < 2 Then Exit For
        Set syfListe = ThisWorkbook.Sheets(s1.Cells(1, i).Value)
        syfListe.Range("A7:Aj" & Rows.Count).Clear
        syfListe.Range("A1:Z6").UnMerge
        s2.Range("A1:Z6").Copy syfListe.Range("A1")
        Application.CutCopyMode = False
        For k = 2 To son
            Set bul = s2.Range("B:B").Find(s1.Cells(k, i).Value, , , 1)
            If Not bul Is Nothing Then
                s2.Range("A" & bul.Row & ":Aj" & bul.Row).Copy syfListe.Cells(syfListe.Cells(Rows.Count, 1).End(3).Row + 1, 1)
                Application.CutCopyMode = False
            End If
        Next
        Rutbe_Sicil_Sirala2 syfListe.Name
        syfListe.Range("A:E").Columns.AutoFit
    Next
    Application.ScreenUpdating = True
    MsgBox "Bitti."
    Set s1 = Nothing: Set s2 = Nothing: Set bul = Nothing: Set syfListe = Nothing

End Sub
Kod:
Private Sub CommandButton2_Click()
    Listele
    Siciller
End Sub


RE: Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak - hayalibey - 22/11/2020

sizdeki dosyadan kontrol sayfası Pden kopyaladım yine olmadı

RE: Şablonu Belirlenen Sayfalara Kopyalama Yöntemi İle Şartlı Dağıtmak - hayalibey - 22/11/2020

Zafer Hocam
liste ve Sicil sayfalarında  isimler ortalanacak time nevs roman 12 punto  olacak imza bilgileri de 12 punto time nevs roman olmalı
Bir de Sicil ve liste sayfalar ıönce A7 den silinmeli baktım şimdi sicil sayfalarında sicil yk ama Sicil 1 2 3 sayfalarında eski veri kalmış onları temizlememiş
Kod baya yavaş çalışıyor  Bilgisayarı donduruyor kod sürekli . dosyayı ekliyorum Hocam
Elinize emeğinize sağlık