Verileri yanyana getirme

[orkunozbudak]

Herkese merhaba elimdeki excel dosyasındaki bazı verileri yanyana getirmek istiyorum. Örnek: A 046 820 45 88 - 001 ile başlayan numaranın altındaki bölge 1 ve bölge 2 numalarını alt alta yazdırmak ve yanlarına A 046 820 45 88 - 001 yazmak istiyorum düşeyara yapmak için yardımcı olursanız sevinirim örneği ekliyorum.Şimdiden teşekkürler

 

[Necdet]

Merhaba,
Verilerin hangi sütundan itibaren geleceği hakkında bir açıklama yapmammışsınız.
Ben de grubun başladığı yerden yazdırmaya çalıştım.

gerekirse kodları kendinize uyarlayınız.

Sub Deneme()

Dim c   As Range
Dim Adr As String
Dim Deg As String
Dim r   As Long
Dim i   As Long

i = 4
With Range("B:B")
    Set c = .Find("KABLO NO", LookIn:=xlValues)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            r = c.Row + 1
            i = c.Row
            Deg = c.Offset(-1, 0)
            Do
                i = i + 1
                Cells(i, "N") = Deg
                Cells(i, "O") = Cells(r, "G")
                Cells(i, "P") = Cells(r, "H")
                r = r + 1
            Loop Until Cells(r, "C") = ""
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
End With

MsgBox "Bitti...."

End Sub

 

[orkunozbudak]

Merhaba,
Verilerin hangi sütundan itibaren geleceği hakkında bir açıklama yapmammışsınız.
Ben de grubun başladığı yerden yazdırmaya çalıştım.

gerekirse kodları kendinize uyarlayınız.

Sub Deneme()

Dim c   As Range
Dim Adr As String
Dim Deg As String
Dim r   As Long
Dim i   As Long

i = 4
With Range("B:B")
    Set c = .Find("KABLO NO", LookIn:=xlValues)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            r = c.Row + 1
            i = c.Row
            Deg = c.Offset(-1, 0)
            Do
                i = i + 1
                Cells(i, "N") = Deg
                Cells(i, "O") = Cells(r, "G")
                Cells(i, "P") = Cells(r, "H")
                r = r + 1
            Loop Until Cells(r, "C") = ""
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
End With

MsgBox "Bitti...."

End Sub

çok teşekkür ederim ellerinize kollarınıza sağlık

 

[volki_112]

Herkese merhaba elimdeki excel dosyasındaki bazı verileri yanyana getirmek istiyorum. Örnek: A 046 820 45 88 - 001 ile başlayan numaranın altındaki bölge 1 ve bölge 2 numalarını alt alta yazdırmak ve yanlarına A 046 820 45 88 - 001 yazmak istiyorum düşeyara yapmak için yardımcı olursanız sevinirim örneği ekliyorum.Şimdiden teşekkürler

Çekim sayfasında P ve Q sütununa istediğiniz verileri yazdırdım. O sütununu yardımcı sütun olarak kullandım. İsterseniz gizleyebilirsiniz.

 

[muhasebeciyiz]

formülle isterseniz buyrun