H sütununda X yazanları diğer sayfaya aktarma

[manisalı88]

Merhaba arkadaşlar, ekte gönderdiğim excel dosyasında babs ile ilgili çalışmam var. Bu sayfada H sütununa X yazılı olanları 'mutabakatlar' sayfasına aktarmasını istiyorum. bu aktarma işlemi aktar düğmesini bastıgımda yapmasını istiyorum. bana yardımcı olabılır misiniz acaba

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub X_Aktar()
 
    Dim c As Range, sat As Long, Adr As Variant, Sb As Worksheet
 
    Set Sb = Sheets("BA BAS ÇALIŞMASI")
 
    Application.ScreenUpdating = False
 
    Sheets("MUTABAKATLAR").Select
    Range("A3:G" & Rows.Count).ClearContents
 
    sat = 3
    With Sb.Range("H:H")
      Set c = .Find("x", , xlValues, xlWhole)
        If Not c Is Nothing Then
          Adr = c.Address
            Do
                Sb.Range("A" & c.Row, "G" & c.Row).Copy Cells(sat, "A")
                sat = sat + 1
 
              Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Application.ScreenUpdating = True
 
 End Sub

.