Rapor verileri düzenleme filtre makro

[delifisek]

Ekli dosyada mtu kısmındaki malzeme çeşitlerini makroda satır olarak ayırarak sheet 1 sheet 2 gibi ayrı sayfalarda mtu bazında görmek istiyorum.yardımcı olabilirseniz sevinirim.

 

[Ömer]

Ekli dosyada mtu kısmındaki malzeme çeşitlerini makroda satır olarak ayırarak sheet 1 sheet 2 gibi ayrı sayfalarda mtu bazında görmek istiyorum.yardımcı olabilirseniz sevinirim.

Merhaba,

Bu şekilde deneyiniz.

Sub SayfalaraAktar()
 
    Dim j As Integer, syf 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 <> "MOBİLYA MAKRO" Then
                .Delete
            End If
        End With
    Next j
    Application.DisplayAlerts = True
 
    For syf = 1 To Worksheets.Count
        With Sheets(syf)
            For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
                If Cells(i, "B") <> "" Then
                   sayfa = Trim(.Cells(i, "B"))
                   If Not varmi(sayfa) Then
                       Sheets.Add After:=Worksheets(Worksheets.Count)
                       ActiveSheet.Name = sayfa
                       .Select
                   End If
 
                   .Range("A1:C1").Copy Sheets(sayfa).Range("A1")
                    son = Sheets(sayfa).Cells(Rows.Count, "A").End(xlUp).Row + 1
                   .Range("A" & i & ":C" & i).Copy Sheets(sayfa).Range("A" & son)
 
                   Sheets(sayfa).Range("A:C").EntireColumn.AutoFit
                End If
            Next i
        End With
    Next syf
 
    Application.ScreenUpdating = True
 
End Sub
 
[COLOR=darkgreen]' ........... Sayfa kontrolu ...........[/COLOR]
 
Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

.

 

[delifisek]

Çok teşekkürler.