Gelişmiş Filtre Uygulamasında Makro İle Listeleme Sorunu - 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ığı: Gelişmiş Filtre Uygulamasında Makro İle Listeleme Sorunu (/konu-gelismis-filtre-uygulamasinda-makro-ile-listeleme-sorunu.html) |
RE: Gelişmiş Filtre Uygulamasında Makro İle Listeleme Sorunu - Oğuz Türkyılmaz - 05/09/2019 (24/08/2019, 13:06)userx yazdı: İki tarih arası rapor filtresi de eklendi.Elinize sağlık bende başka bir kaynaktan çözdüm farklı bir şekilde. RE: Gelişmiş Filtre Uygulamasında Makro İle Listeleme Sorunu - userx - 06/09/2019 (05/09/2019, 23:42)Oğuz Türkyılmaz yazdı:(24/08/2019, 13:06)userx yazdı: İki tarih arası rapor filtresi de eklendi.Elinize sağlık bende başka bir kaynaktan çözdüm farklı bir şekilde. Sub Suz() Set s1 = Sheets("LİSTE") eski = WorksheetFunction.Max(1, s1.Cells(Rows.Count, "B").End(1).Row) s1.Range("B2:G" & eski) = "" For sayfa = 1 To 2 'Sheets.Count If Sheets(sayfa).Name <> s1.Name Then For i = 1 To 100 yeni = s1.Cells(Rows.Count, "B").End(3).Row + 1 s1.Range("B" & yeni) = Sheets(sayfa).Range("B" & i + 1) s1.Range("C" & yeni) = Sheets(sayfa).Range("C" & i + 1) s1.Range("D" & yeni) = Sheets(sayfa).Range("D" & i + 1) s1.Range("E" & yeni) = Sheets(sayfa).Range("E" & i + 1) s1.Range("F" & yeni) = Sheets(sayfa).Range("F" & i + 1) s1.Range("G" & yeni) = Sheets(sayfa).Range("G" & i + 1) Next End If Next Sheets("LİSTE").Columns("B:G").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("B1:G2", "H1:M2"), CopyToRange:=Range("B10:G6500"), Unique:= _ False ActiveWorkbook.Worksheets("RAPOR").Sort.SortFields.Clear ActiveWorkbook.Worksheets("RAPOR").Sort.SortFields.Add Key:=Range("B11:B65000"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("RAPOR").Sort .SetRange Range("B11:G65000") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("B11").Select End Sub şeklinde değiştirirseniz düzelecektir. |