Aynı Satırdaki Farklı Hücrelerdeki Verileri Alt Satırda Yazdırma

[yanlizman]

Arkadaşlar,

Elimde kdv oranları ve matrahları aynı satırda olan excel dosyası mevcut.
Alt tarafta paylaştığım gibi üst taraftaki orjinal dosya alt taraftakide yapmak istediğim.
Ayı satırdaki verileri yüzde 8 lik kısımda alt alta yazmak istiyorum.
Buna göre nasıl bir formül uygulayabilirim.
Yardımlarınız için teşekkür ederim.

Tarih	e-belge No	Vade	KDV (%1)	KDV (%1) - Matrah	KDV (%8)	KDV (%8) - Matrah	KDV (%18)	KDV (%18) - Matrah
01-11-2022	A402022000011660	212​	10,00​	1000,00​	11,76​	147,00​	18,00​	100,00​
01-11-2022	A402022000011661	212​	20,00​	2000,00​	11,76​	147,00​	36,00​	200,00​
				Yapmak İstediğim Şekil
Tarih	e-belge No	kdv oranı	KDV (%1)	KDV (%1) - Matrah	KDV (%8)	KDV (%8) - Matrah	KDV (%18)	KDV (%18) - Matrah
01-11-2022	B402022000011660	8​			11,76​	147,00​
01-11-2022	B402022000011660	1​			10,00​	1000,00​
01-11-2022	B402022000011660	18​			18,00​	100,00​
01-11-2022	B402022000011661	8​			11,76​	147,00​
01-11-2022	B402022000011661	1​			20,00​	2000,00​
01-11-2022	B402022000011661	18​			36,00​	200,00​

 

[Ömer]

Merhaba,

1 ve 18 de %8 olan sütunun altına yazmışsınız. Yazım doğru mu?

 

[yanlizman]

Merhaba,

1 ve 18 de %8 olan sütunun altına yazmışsınız. Yazım doğru mu?

evet doğrudur. 1 - 8 ve 18 lik kısımlar alt alta gelsin kafi.

 

[Ömer]

Deneyiniz.
Sayfa1 deki verileri Sayfa2 ye listeler.

Sub test()
    
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, sat As Long, j As Byte
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    S2.Select
    Range("A2:I" & Rows.Count).ClearContents
    
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        For j = 4 To 8
            If j Mod 2 = 0 Then
                Cells(sat, "A") = S1.Cells(i, "A")
                Cells(sat, "B") = S1.Cells(i, "B")
                Cells(sat, "C") = S1.Cells(1, j)
                Cells(sat, "F") = S1.Cells(i, j)
                Cells(sat, "G") = S1.Cells(i, j + 1)
                sat = sat + 1
            End If
        Next j
    Next i
    
End Sub

 

[yanlizman]

Deneyiniz.
Sayfa1 deki verileri Sayfa2 ye listeler.

Sub test()
   
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, sat As Long, j As Byte
   
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
   
    Application.ScreenUpdating = False
    S2.Select
    Range("A2:I" & Rows.Count).ClearContents
   
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        For j = 4 To 8
            If j Mod 2 = 0 Then
                Cells(sat, "A") = S1.Cells(i, "A")
                Cells(sat, "B") = S1.Cells(i, "B")
                Cells(sat, "C") = S1.Cells(1, j)
                Cells(sat, "F") = S1.Cells(i, j)
                Cells(sat, "G") = S1.Cells(i, j + 1)
                sat = sat + 1
            End If
        Next j
    Next i
   
End Sub

Üstad teşekkür ederim. Sadece 0 olanların gürünmemesi için ufak bir ayar yaptım.

Sub test()
Dim S1 As Worksheet, S2 As Worksheet, i As Long, sat As Long, j As Byte
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    S2.Select
    Range("A2:O" & Rows.Count).ClearContents
    
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        For j = 4 To 8
            If j Mod 2 = 0 Then
             If S1.Cells(i, j) <> 0 Then' Eklenen kod
                Cells(sat, "A") = S1.Cells(i, "A")
                Cells(sat, "B") = S1.Cells(i, "B")
                Cells(sat, "C") = S1.Cells(1, j)
                Cells(sat, "F") = S1.Cells(i, j)
                Cells(sat, "G") = S1.Cells(i, j + 1)
                sat = sat + 1
                End If
            End If
        Next j
    Next i
    
End Sub