sıralı filitre ile data alma

[catalinastrap]

Merhabalar,
bir excel listem var ve burada isimler mecvcut istediğim filitre yi sıralı şekilde seçip diğer sayfaya istediğim datayı alması

filitre : ahmet mehmeh en üstte bunu seçecek sonra ahmet mert i seçecek sonra ... şekilde devam edeceka ama ben beceremedim tek seçebiiyorum sadece yardımcı olabilirmisiniz





Sub zimmet()
'
'
'

'
ActiveSheet.Range("$A$1:$H$1575").AutoFilter Field:=2, Criteria1:= _
"ahmet mehmet"
Range("C2:E1596").Select
Selection.Copy
Sheets("Sayfa1").Select
Range("B9").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=33
End Sub

 

[Ömer]

Merhaba,

Örnek dosya ekleyerek daha detaylı açıklar mısınız.

 

[catalinastrap]

Merhaba,

Örnek dosya ekleyerek daha detaylı açıklar mısınız.

umarım örnek dosya yeterli olur

 

[Ömer]

Doğru anlamışımdır umarım. Print alan 2 satırı pasif yaptım. Siz duruma göre aktif yaparsınız.

Sub test()
    
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, d As Object, deg As String, a, son As Long
      
    Set S1 = Sheets("liste")
    Set S2 = Sheets("form")
    
    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
    S1.Select
    
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "B")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i
    
    S2.Select
    a = d.keys
    For i = 0 To d.Count - 1
        Range("B9:G" & Rows.Count).ClearContents
        S1.Range("A:G").AutoFilter Field:=2, Criteria1:=a(i)
        son = S1.Cells(Rows.Count, "A").End(xlUp).Row
        S1.Range("C2").Resize(son, 3).Copy Range("B9")
        Range("C5") = S1.Cells(son, "G")
        Range("C6") = S1.Cells(son, "B")
        Range("C7") = S1.Cells(son, "A")
        'S2.PrintOut
        'Application.Wait (Now + TimeValue("00:00:01"))
    Next i
    
    
    On Error Resume Next
    S1.ShowAllData
    
    MsgBox "İşleminiz Bitti."
    
End Sub

 

[catalinastrap]

bu kodu 45. satıra kadar uygula diyebilirmiyiz

Range("B9:G" & Rows.Count).ClearContents

 

[Ömer]

Deneyiniz.

Range("B9:G45").ClearContents

.

 

[catalinastrap]

Deneyiniz.

Range("B9:G45").ClearContents

.

bu satırda da aynı hatayı aldım bunuda 45. satır olarak düzenleyebilirmiyiz
45.satırdan sonra birleşik hücreler var formda o nedenle hata alıyorum
S1.Range("C2").Resize(son, 3).Copy Range("B9")

 

[catalinastrap]

çok teşekkür ederim

 

[Ömer]

Deneyinz.

Sub test()
    
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, d As Object, deg As String, a, son As Long
      
    Set S1 = Sheets("liste")
    Set S2 = Sheets("form")
    
    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
    S1.Select
    
    For i = 2 To 45
        deg = Cells(i, "B")
        If deg <> "" Then
            If Not d.exists(deg) Then
                d.Add deg, Nothing
            End If
        End If
    Next i
    
    S2.Select
    a = d.keys
    For i = 0 To d.Count - 1
        Range("B9:G45").ClearContents
        S1.Range("A1:G45").AutoFilter Field:=2, Criteria1:=a(i)
        son = S1.Cells(45, "A").End(xlUp).Row
        S1.Range("C2").Resize(son, 3).Copy Range("B9")
        Range("C5") = S1.Cells(son, "G")
        Range("C6") = S1.Cells(son, "B")
        Range("C7") = S1.Cells(son, "A")
        'S2.PrintOut
        'Application.Wait (Now + TimeValue("00:00:01"))
    Next i
    
    
    On Error Resume Next
    S1.ShowAllData
    
    MsgBox "İşlem Bitti."
    
End Sub