Ara Bul yan satırlara yaz makrosu arıyorum

A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
293
Excel Vers. ve Dili
2010
Merhaba sayfada A sütünunda herhangi bir satırda sütün sabit herzaman tabi, ama satırlar alt satırlara doğru gidiyor EVRAK ID yazan satırı bul,(A) sütünü ve hemen karşısında B sütununda yazan
örnek =(A) EVRAK ID sütunu (B) 12252 sütununda karşısında sabit sayı değeri var, o sayıyı kopyala alt satırlarda yazan

Sıra Özellik Açıklama Miktar Birim Fiyat Durumu
bu satıra sıra no kaçtane ise kopyala yaz gibi bir makro istiyorum mümkünse herkese iyi çalışmlalar bu işlem tüm sayfada olacak iyi çalışmalar..
 
dEdE

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,598
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Merhaba

Bu tür sorular örnek dosya ile desteklenmediği sürece genellikle ilgi çekmez ve genellikle cevap verilmez.
Dosya paylaşım siteleri üzerinden örnek dosyada ne istediğinizi anlatıp varmak istediğiniz sonucu gösterirseniz daha kolay yanıt alırsınız.
 
A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
293
Excel Vers. ve Dili
2010
dEdE' Alıntı:
Merhaba

Bu tür sorular örnek dosya ile desteklenmediği sürece genellikle ilgi çekmez ve genellikle cevap verilmez.
Dosya paylaşım siteleri üzerinden örnek dosyada ne istediğinizi anlatıp varmak istediğiniz sonucu gösterirseniz daha kolay yanıt alırsınız.
Genişletmek için tıkla ...
merhaba dosyam paylaşıyorum
EVRAK SORGU.xlsx - 11 KB
sorum şu ilgili sayfada (EVRAK ID ) yazan sayfa,, EVRAK ID yazan kısmın karşısında ki ismi al,sonra bir alt satırda SAHİP yazan kısmın karşısında ki ismi al, sonra alt satırlarda SIRA ÖZELLİK,AÇIKLAMA,MİKTAR,TEMİN DURUMU,EVRAK ID,SAHİP, TEMİN DURUMU ALANI başlıkları altında ki verileri al EVRAK ID sayfasından süzüp ayıklayıp sonra da SORGU sayfasına ilgili başlıkların altına yapıştırmasını makro kodları ile istiyorum. mümkünse teşekkürler..
 
A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
293
Excel Vers. ve Dili
2010
Merhaba hayırlı akşamlar destek ekibi ve makro yazabilen arkadaşlar ekteki dosyam ii
için yardımcı olurmusunuz? Teşekkürler.
 
A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
293
Excel Vers. ve Dili
2010
Merhaba hayırlı akşamlar sevgili ustalar sorunumu çözemedim yardımcı olabilirmisniz? Teşekkürler
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,122
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Örnek dosyanız için aşağıdaki kodu deneyiniz.
PHP: 
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Dim eID As String, shp As String
Dim a As Long

Set s1 = Sheets("EVRAK ID ")
Set s2 = Sheets("SORGU")
ReDim dz(1 To 9, 1 To 1)
For a = 3 To s1.Cells(Rows.Count, "A").End(3).Row
    If s1.Cells(a, "A") = "Evrak ID" Then
        eID = s1.Cells(a, "B")
        shp = s1.Cells(a + 1, "B")
    ElseIf s1.Cells(a, "A") <> "" And IsNumeric(s1.Cells(a, "A")) Then
        x = x + 1
        ReDim Preserve dz(1 To 9, 1 To x)
        dz(1, x) = s1.Cells(a, "A") 'sıra
        dz(2, x) = s1.Cells(a, "B") 'özellik
        dz(3, x) = s1.Cells(a, "C") 'açıklama
        dz(4, x) = s1.Cells(a, "D") 'miktar
        dz(5, x) = s1.Cells(a, "E") 'birim
        dz(6, x) = s1.Cells(a, "F") 'temin durumu
        dz(7, x) = eID 'Evrak id
        dz(8, x) = shp 'sahip
        dz(9, x) = s1.Cells(a, "G") 'td alanı
    End If
Next
s2.Range("A2").Resize(UBound(dz, 2), UBound(dz)).Value = Application.Transpose(dz)
End Sub
 
A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
293
Excel Vers. ve Dili
2010
ÖmerBey' Alıntı:
Merhaba,
Örnek dosyanız için aşağıdaki kodu deneyiniz.
PHP: 
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Dim eID As String, shp As String
Dim a As Long

Set s1 = Sheets("EVRAK ID ")
Set s2 = Sheets("SORGU")
ReDim dz(1 To 9, 1 To 1)
For a = 3 To s1.Cells(Rows.Count, "A").End(3).Row
    If s1.Cells(a, "A") = "Evrak ID" Then
        eID = s1.Cells(a, "B")
        shp = s1.Cells(a + 1, "B")
    ElseIf s1.Cells(a, "A") <> "" And IsNumeric(s1.Cells(a, "A")) Then
        x = x + 1
        ReDim Preserve dz(1 To 9, 1 To x)
        dz(1, x) = s1.Cells(a, "A") 'sıra
        dz(2, x) = s1.Cells(a, "B") 'özellik
        dz(3, x) = s1.Cells(a, "C") 'açıklama
        dz(4, x) = s1.Cells(a, "D") 'miktar
        dz(5, x) = s1.Cells(a, "E") 'birim
        dz(6, x) = s1.Cells(a, "F") 'temin durumu
        dz(7, x) = eID 'Evrak id
        dz(8, x) = shp 'sahip
        dz(9, x) = s1.Cells(a, "G") 'td alanı
    End If
Next
s2.Range("A2").Resize(UBound(dz, 2), UBound(dz)).Value = Application.Transpose(dz)
End Sub
Genişletmek için tıkla ...
Merhaba ömer bey harikasınız kodlar sorunsuz çalışıyor, Allah razı olsun. sadece kodlara ek olarak bir ricam olacak, EVRAK ID sayfasında SIRA başlığı altında 1 2 3 4 diye giden satırlrdan sonra boşluk var sonraki satırları getirmesin istiyorum nasıl bir kod eklemeliyim. Teşekkürler.
 
A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
293
Excel Vers. ve Dili
2010
ADER_34' Alıntı:
Merhaba ömer bey harikasınız kodlar sorunsuz çalışıyor, Allah razı olsun. sadece kodlara ek olarak bir ricam olacak, EVRAK ID sayfasında SIRA başlığı altında 1 2 3 4 diye giden satırlrdan sonra boşluk var sonraki satırları getirmesin istiyorum nasıl bir kod eklemeliyim. Teşekkürler.
Genişletmek için tıkla ...
merhabalar öncelikle hayırlı haftalar herkese, Ömer bey yazdığınız kodlara ek olarak hangi kodları eklemeliyim teşekkürler.
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,122
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Örnek dosyanızda deneme yaptığımda bahsettiğiniz sorun oluşmuyor. Kendi dosyanıza uygun bir örnek dosya paylaşırsanız üzerinde çalışılabilir.
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,122
Excel Vers. ve Dili
2007 Türkçe
Tekrar merhaba,
En son paylaştığınız dosyaya 6 numaralı mesajda paylaştığım kodu uyguladım (Lütfen siz de deneyiniz.) ve sonuç: Sizin istemediğinizi belirttiğiniz satırlar zaten listelenmiyor. Yani belirttiğiniz sorunu içeren bir dosya olmamış.
Tahmine dayalı olarak kodu, aşağıdaki şekilde güncelledim.
Deneyiniz, istediğiniz sonucu vermezse lütfen buna uygun bir dosya paylaşınız.
PHP: 
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Dim eID As String, shp As String
Dim a As Long
Dim k As Double

Set s1 = Sheets("EVRAK ID ")
Set s2 = Sheets("SORGU")
ReDim dz(1 To 9, 1 To 1)
For a = 3 To s1.Cells(Rows.Count, "A").End(3).Row
    If s1.Cells(a, "A") = "Evrak ID" Then
        eID = s1.Cells(a, "B")
        shp = s1.Cells(a + 1, "B")
    ElseIf s1.Cells(a, "A") = "Sıra" Then
        k = True
    ElseIf s1.Cells(a, "A") = "" Then
        k = False
    ElseIf k = True And IsNumeric(s1.Cells(a, "A")) Then
        x = x + 1
        ReDim Preserve dz(1 To 9, 1 To x)
        dz(1, x) = s1.Cells(a, "A") 'sıra
        dz(2, x) = s1.Cells(a, "B") 'özellik
        dz(3, x) = s1.Cells(a, "C") 'açıklama
        dz(4, x) = s1.Cells(a, "D") 'miktar
        dz(5, x) = s1.Cells(a, "E") 'birim
        dz(6, x) = s1.Cells(a, "F") 'temin durumu
        dz(7, x) = eID 'Evrak id
        dz(8, x) = shp 'sahip
        dz(9, x) = s1.Cells(a, "G") 'td alanı
    End If
Next
s2.Range("A2").Resize(UBound(dz, 2), UBound(dz)).Value = Application.Transpose(dz)
End Sub
 
A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
293
Excel Vers. ve Dili
2010
ÖmerBey' Alıntı:
Tekrar merhaba,
En son paylaştığınız dosyaya 6 numaralı mesajda paylaştığım kodu uyguladım (Lütfen siz de deneyiniz.) ve sonuç: Sizin istemediğinizi belirttiğiniz satırlar zaten listelenmiyor. Yani belirttiğiniz sorunu içeren bir dosya olmamış.
Tahmine dayalı olarak kodu, aşağıdaki şekilde güncelledim.
Deneyiniz, istediğiniz sonucu vermezse lütfen buna uygun bir dosya paylaşınız.
PHP: 
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Dim eID As String, shp As String
Dim a As Long
Dim k As Double

Set s1 = Sheets("EVRAK ID ")
Set s2 = Sheets("SORGU")
ReDim dz(1 To 9, 1 To 1)
For a = 3 To s1.Cells(Rows.Count, "A").End(3).Row
    If s1.Cells(a, "A") = "Evrak ID" Then
        eID = s1.Cells(a, "B")
        shp = s1.Cells(a + 1, "B")
    ElseIf s1.Cells(a, "A") = "Sıra" Then
        k = True
    ElseIf s1.Cells(a, "A") = "" Then
        k = False
    ElseIf k = True And IsNumeric(s1.Cells(a, "A")) Then
        x = x + 1
        ReDim Preserve dz(1 To 9, 1 To x)
        dz(1, x) = s1.Cells(a, "A") 'sıra
        dz(2, x) = s1.Cells(a, "B") 'özellik
        dz(3, x) = s1.Cells(a, "C") 'açıklama
        dz(4, x) = s1.Cells(a, "D") 'miktar
        dz(5, x) = s1.Cells(a, "E") 'birim
        dz(6, x) = s1.Cells(a, "F") 'temin durumu
        dz(7, x) = eID 'Evrak id
        dz(8, x) = shp 'sahip
        dz(9, x) = s1.Cells(a, "G") 'td alanı
    End If
Next
s2.Range("A2").Resize(UBound(dz, 2), UBound(dz)).Value = Application.Transpose(dz)
End Sub
Genişletmek için tıkla ...
Ömer Bey kodlar harika çalışıyor,Allah razı olsun çok teşekkür ederim bu konu çözüldü.hayırlı günler hayırlı işleriniz olsun..
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,122
Excel Vers. ve Dili
2007 Türkçe
Rica ederim,
Allah hepimizden razı olsun,
İyi çalışmalar...
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst