filitre yaparak ilgili kısmı diğer sayfalara kaydetme

[search77]

Merhaba Arkadaşlar,

Ekli dosyamda macro mevcuttur, bu macro filitre yaparak masaüstünde filitre yapılan kısmı ayrı ayrı dosya olarak kaydediyor.

Benim istediğim ayrı ayrı dosya olarak değil kendi excel içindeki sayfa1, sayfa2 ... gibi filitre yapılan kısmı sayfalara kaydetmesi.

Yardımcı olacak arkadaşlara şimdiden çok çok teşekkür ederim.

Saygılarımla.

 

[Murat OSMA]

Şu kodları Module yazıp F5'e basınız;

Sub SayfaAktar()
Dim i As Integer, j As Integer
Dim Sayfa As String
Dim S1 As Worksheet
Set S1 = Sheets("Sheet1")
Application.ScreenUpdating = False
For j = 3 To Worksheets.Count
    Sheets(j).Cells.Delete Shift:=xlUp
Next j
For i = 2 To S1.[A65536].End(3).Row
    Sayfa = S1.Cells(i, "A")
        If Not SayfaVarMi(Sayfa) Then
            Sheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Sayfa
            S1.Select
        End If
    S1.Range("A1:J1").Copy Sheets(Sayfa).Range("A1")
    S1.Range("A" & i & ":J" & i).Copy Sheets(Sayfa).Range("A" & _
    Sheets(Sayfa).[A65536].End(3).Row + 1)
    Sheets(Sayfa).Range("A:J").EntireColumn.AutoFit
Next i
Set S1 = Nothing: Sayfa = vbNullString
j = Empty: i = Empty
Application.ScreenUpdating = True
End Sub

Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

 

[search77]

Murat bey,

Süper oldu, tam benim istediğim gibi,

Elinize sağlık, emeğinize sağlık.

Saygı ve sevgilerimle.