Aranan Bilginin sirali olarak getirilmesi

[ghurbei]

Merhaba ;

Ekteki dosyada gonderdigim soru su sekildedir.

Dosya icindeki ISLEM MENUSU tabina girilen bilgilerin , ilgili hisseye ait sayfaya getirilmesi konusudur. Girdigim bilgileri, ilgili dosyaya getiriyorum. ancak sectigim araliktaki ilk bilgiyi getiriyor. Farkli tarihlerde farkli hisseler icin islem yapilmis olabilir. bunlari sirali bir bicimde ilgili hissenin sayfasina nasil getirebiliriz?

 

[Ömer]

Merhaba,

Bu şekilde deneyin.
Kodlar önce işlem menüsü, fiyat ve şablon sayfaları hariç diğer tüm sayfaları siler, daha sonra işlem menüsü sayfası C sütununa göre şablon sayfasına uygun sayfa açar ve verileri ilgili sayfalara aktarır.

Sub Sayafalara_Dagit()
 
    Dim j As Integer, i As Long, sayfa As String, son As Long
 
    Application.ScreenUpdating = False
 
    Application.DisplayAlerts = False
    For j = Worksheets.Count To 1 Step -1
        With Sheets(j)
            If .Name <> "ISLEM MENUSU" And _
                .Name <> "FİYAT" And .Name <> "SABLON" Then
                .Delete
            End If
        End With
    Next j
    Application.DisplayAlerts = True
    With Sheets("ISLEM MENUSU")
        For i = 4 To .Cells(Rows.Count, "B").End(xlUp).Row
            If Cells(i, "B") <> "" Then
               sayfa = Trim(.Cells(i, "B"))
               If Not varmi(sayfa) Then
                   Sheets("SABLON").Copy After:=Sheets(Sheets.Count)
                   ActiveSheet.Name = sayfa
                   .Select
               End If
               son = Sheets(sayfa).Cells(Rows.Count, "B").End(xlUp).Row + 1
               Sheets(sayfa).Cells(son, "B") = .Cells(i, "A")
               Sheets(sayfa).Cells(son, "C") = .Cells(i, "C")
               Sheets(sayfa).Cells(son, "D") = .Cells(i, "D")
               Sheets(sayfa).Cells(son, "E") = .Cells(i, "E")
            End If
        Next i
    End With
 
    Application.ScreenUpdating = True
End Sub
 
Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

.