Sayfalardan veri alma

[n_dinc]

Arkadaşlar ekli evrak kayıt programında İç ve Dış zimmette girilen tarihler ve hizasındaki diğer bilgileri alabiliyoruz. Benim istediğim 2 tarih girilmesi ve bu tarihler arasındaki bilgilerin İç ve Dış zimmet sayfasına bilgilerin aktarılması. Yardımcı olursanız sevinirim. Şimdiden teşekkür ederim.

 

[n_dinc]

Arkadaşlar yardım lütfen.

 

[n_dinc]

Arkadaşlar program normalde çalışıyor. Biraz değişiklik gerekiyor. Yütfen Yardım.

 

[Excelmy]

Sayın n_dinc

İlgili kod BURADA size bildirilmişti.
Düzenleyemediğinizi belirtmişsiniz ama dikkatimden kaçmış olmalı bu mesajınızı görmemişim.

VBA menüsü Modül4 kodlarınız.

Sub liste()
Dim i As Integer, j As Long, sat As Long
Sheets("100").Select
Range("aa3:ae65536").ClearContents
If Range("AC1").Value = "" Then
    MsgBox "AC1 Hücresine Tarih Giriniz !.", vbCritical
    Range("AC1").Select
    Exit Sub
End If
sat = 3
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "100" Then
        sonsat = Sheets(i).Cells(65536, "aa").End(xlUp).Row
            For j = 1 To sonsat
                If sat = 65535 Then
                    MsgBox "Sayfa doldu . Başka kayıt yapamazsınız..!!", vbCritical
                    Exit Sub
                End If
                If UCase(Replace(Replace(Range("AC1").Value, "ı", "I"), "i", "İ")) = "HEPSİ" Then
                    Range("aa" & sat & ":ae" & sat).Value = Sheets(i).Range("aa" & j & ":ae" & j).Value
                    sat = sat + 1
                    ElseIf Sheets(i).Cells(j, "D") >= Sheets("100").Range("AC1") And Sheets(i).Cells(j, "D") <= Sheets("100").Range("AD1") Then
                        Range("aa" & sat & ":ae" & sat).Value = Sheets(i).Range("aa" & j & ":ae" & j).Value
                        sat = sat + 1
                End If
            Next j
    End If
Next i
MsgBox "L İ S T E L E M E   Y A P I L D I ..!!"
End Sub

VBA menüsü Modül5 kodlarınız.

Sub liste()
Dim i As Integer, j As Long, sat As Long
Sheets("101").Select
Range("ag3:ao65536").ClearContents
If Range("AN1").Value = "" Then
    MsgBox "AN1 Hücresine Tarih Giriniz !", vbCritical
    Range("AN1").Select
    Exit Sub
End If
sat = 3
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "101" Then
        sonsat = Sheets(i).Cells(65536, "ag").End(xlUp).Row
            For j = 1 To sonsat
                If sat = 65535 Then
                    MsgBox "Sayfa doldu . Başka kayıt yapamazsınız..!!", vbCritical
                    Exit Sub
                End If
                If UCase(Replace(Replace(Range("AN1").Value, "ı", "I"), "i", "İ")) = "HEPSİ" Then
                    Range("ag" & sat & ":ao" & sat).Value = Sheets(i).Range("ag" & j & ":ao" & j).Value
                    sat = sat + 1
                    ElseIf Sheets(i).Cells(j, "D") >= Sheets("101").Range("AN1") And Sheets(i).Cells(j, "D") <= Sheets("101").Range("AO1") Then
                        Range("ag" & sat & ":ao" & sat).Value = Sheets(i).Range("ag" & j & ":ao" & j).Value
                        sat = sat + 1
                End If
            Next j
    End If
Next i
MsgBox "L İ S T E L E M E   Y A P I L D I ..!!"
End Sub

Birebir değiştiriniz.

 

[n_dinc]

Sayın Kuman
Yardımların için çok teşekkür ederim. Allah Razı Olsun. Salgılar.