Eğersay Düşey ara Hk.

[gicimi]

Eklemiş olduğum dosyada sayfa1 ve sayfa2 aynı verileri sayfa3 yazmasını istiyorum. yardımcı olurmusunuz?

 

[Orion1]

Tesisat numaralarına göre sorguluyor.
Dosyanız ektedir.

Sub tesisat59()
'prosedürü başlatıyoruz.
Dim sonsat As Long, sat As Long, i As Long, k As Range
Dim s1 As Worksheet, s2 As Worksheet
'dim ile değişkenleri tanımlıyoruz.
Sheets("Sayfa3").Select
'sayfa3 ' ü seçiyoruz.
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
'S1 ile sayfa1'i,S2 ile sayfa2'yi set ediyoruz.
Range("A2:H" & Rows.Count).Clear
'Aktif sayfada A2:A1040000 aralığını temizliyoruz.
Application.ScreenUpdating = False
'Verileri hücreler alırken ekranda gösterme özelliğini iptal ediyoruz
sonsat = s1.Cells(Rows.Count, "A").End(xlUp).Row
'sonsat değişkenine sayfa1 deki sonuncu stırın numarasını alıyoruz.
sat = 2
'sat değişkenine 2 sayısını atıyoruz.
For i = 2 To sonsat
'for değişkenini başlatıyoruz.2nci satırrdan sonsat değişkeni içindeki satıra kadar döneceğiz.
    Set k = s2.Range("A2:A" & Rows.Count).Find(s1.Cells(i, "A").Value, , xlValues, xlWhole)
'2nci sayfada A sütununda 1nci sayafada döngüdeki değeri arıyoruz.
    If Not k Is Nothing Then
'eğer değer varsa
        s1.Range("A" & k.Row & ":H" & k.Row).Copy Range("A" & sat)
'1nci sayfadan bulduğu satırı copyalıyoruz ve 2nci sayfaya a sütununa yapıştırıyoruz.
        Application.CutCopyMode = False
'kesme ve kopyalama modunu false ediyoruz.
        sat = sat + 1
'sat değişkenine 1 ekliyoruz
    End If
' sorguyu bitiriyoruz
    Set k = Nothing
'k değişkenini sıfırlıyoz.
Next i
'döngüyü sonlandırıyoruz.
Application.ScreenUpdating = True
'ekran görünütrlüğünü aktif ediyoruz.
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
'mesaj kutusu ile mesaj veriyoruz.
End Sub
'Prosedürü Sonlandırıyoruz.

 

[gicimi]

Tesisat numaralarına göre sorguluyor.
Dosyanız ektedir.

Sub tesisat59()
Dim sonsat As Long, sat As Long, i As Long, k As Range
Dim s1 As Worksheet, s2 As Worksheet
Sheets("Sayfa3").Select
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Range("A2:H" & Rows.Count).Clear
Application.ScreenUpdating = False
sonsat = s1.Cells(Rows.Count, "A").End(xlUp).Row
sat = 2
For i = 2 To sonsat
    Set k = s2.Range("A2:A" & Rows.Count).Find(s1.Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        s1.Range("A" & k.Row & ":H" & k.Row).Copy Range("A" & sat)
        Application.CutCopyMode = False
        sat = sat + 1
    End If
    Set k = Nothing
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
End Sub

Makro bilmiyorum formül olarak yardımcı olabilirmisiniz?

 

[Orion1]

Ben sayfaya buton koydum.Siz sadece butona tıklayacaksınız.

 

[gicimi]

Ben sayfaya buton koydum.Siz sadece butona tıklayacaksınız.

Teşekür ederim. yeni bi satır ekleyip yeni bi başlık açtığımda nasıl bi yol izleyeceğim. Makro bilmediğim için eklediğim satırın bilgileri nasıl gelcek sayfa3 ?

 

[Orion1]

Teşekür ederim. yeni bi satır ekleyip yeni bi başlık açtığımda nasıl bi yol izleyeceğim. Makro bilmediğim için eklediğim satırın bilgileri nasıl gelcek sayfa3 ?

Yeni bir satır eklediğinizde kodlar onu otomatik olarak algılayacaklar.
Sütun için ise A:H sütunları aralığında çalışmaktadır.
Sütunları baştan belirtmek gerekiyor.
Yani değişiklik yapılacaksa A:H aralığında kod ufak bir operasyon gerekiyor.

 

[gicimi]

Yeni bir satır eklediğinizde kodlar onu otomatik olarak algılayacaklar.
Sütun için ise A:H sütunları aralığında çalışmaktadır.
Sütunları baştan belirtmek gerekiyor.
Yani değişiklik yapılacaksa A:H aralığında kod ufak bir operasyon gerekiyor.[/Q]

teşekkürler yardımınız için