makro ile hücre değerlerine satırları taşıma

onur3466

Altın Üye
Katılım
31 Ağustos 2019
Mesajlar
173
Excel Vers. ve Dili
Ofis 2019 TR
Altın Üyelik Bitiş Tarihi
24-11-2026
Merhaba arkadaşlar,
m2 hücresine a tünunda yer alan herhangi bir seri numarasını girip, m3 hücresine de b sütunundan tarih girdiğimde ikisininde denk geldiği satırları ,1 satırdaki başlık dahil sayfa 2 ye atmasını istiyorum.
Bu konuda yardımcı olabilir misiniz?
 

Ekli dosyalar

  • 1.7 MB Görüntüleme: 3

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,170
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
Eki deneyin.
İyi çalışmalar.
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,166
Excel Vers. ve Dili
2019 Türkçe
Merhaba.

Alternatif

Sayfa1'in kod sayfasına aşağıdaki kodları kopyalayın.

M2 ve M3 de bir değişiklik yaparsanız kodlar otomatik çalışacaktır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    Dim Bak As Long
    Dim IlkSatir As Long
    Dim SonSatir As Long
    Dim Son As Long
  
    If Not Intersect(Range("M2:M3"), Target) Is Nothing Then
        If Range("M2") <> "" And Range("M3") <> "" Then
            Set Bul = Range("A:A").Find(what:=Range("M2").Value, lookat:=xlWhole)
            If Bul Is Nothing Then
                MsgBox "Seri Numarası bulunamadı.", vbExclamation
                Exit Sub
            Else
                For Bak = Target.Row To Cells(Rows.Count, "A").End(xlUp).Row
                    If Cells(Bak, "A").Value = Range("M2").Value And Cells(Bak, "B").Value = Range("M3").Value Then
                        If IlkSatir = 0 Then IlkSatir = Bak
                  
                        If IlkSatir > 0 Then SonSatir = Bak

                    End If
                Next
                If SonSatir = 0 Then
                    MsgBox "Belirttiğiniz tarih bulunamadı.", vbExclamation
                    Exit Sub
                End If
                Son = Worksheets("Sayfa2").Cells(Rows.Count, "A").End(xlUp).Row + 1
                Application.ScreenUpdating = False
                Rows(IlkSatir & ":" & SonSatir).Copy Worksheets("Sayfa2").Cells(Son, "A")
                Application.ScreenUpdating = True
                MsgBox "Aktarma tammalandı", vbInformation
            End If
        End If
    End If
End Sub
 

onur3466

Altın Üye
Katılım
31 Ağustos 2019
Mesajlar
173
Excel Vers. ve Dili
Ofis 2019 TR
Altın Üyelik Bitiş Tarihi
24-11-2026
252560

çalıştırdığımda bu şekilde ekran çıkıyor ve işlem yapmama izin vermiyor.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,166
Excel Vers. ve Dili
2019 Türkçe
Sanırım benim verdiğim kodlar için söylüyorsunuz.
Kodların üstünde açıklama yapmıştım.
Kodlar OTOMATİK çalışacaktır.
 

onur3466

Altın Üye
Katılım
31 Ağustos 2019
Mesajlar
173
Excel Vers. ve Dili
Ofis 2019 TR
Altın Üyelik Bitiş Tarihi
24-11-2026
hallettim çok teşekkür ederim muzaffer bey ve uygun bey . gerçekten sayenizde bende yavaş yavaş öğreniyorum :)
 
Üst