Üç tablodan veri alma

[ycimen]

Ek'teki örnek dosyada, üç ve ya daha fazla listeden seçili olanları başka bir listede boşluksuz olarak listelekmek istiyorum.

 

[Recep İpek]

Aağıdaki kodları kullanabilirsiniz.

Sub Listele()
Set s1 = Sheets("Sayfa1")
s1.[a5:c100].ClearContents
[a5].Select
For i = 5 To s1.[f65536].End(3).Row
If s1.Cells(i, "h").Value > 0 Then
sat = s1.[a65536].End(3).Row + 1
s1.Cells(sat, "a").Value = s1.Cells(i, "f").Value
s1.Cells(sat, "b").Value = s1.Cells(i, "g").Value
s1.Cells(sat, "c").Value = s1.Cells(i, "h").Value
End If
Next i
For i = 5 To s1.[j65536].End(3).Row
If s1.Cells(i, "L").Value > 0 Then
sat = s1.[a65536].End(3).Row + 1
s1.Cells(sat, "a").Value = s1.Cells(i, "j").Value
s1.Cells(sat, "b").Value = s1.Cells(i, "k").Value
s1.Cells(sat, "c").Value = s1.Cells(i, "L").Value
End If
Next i
For i = 5 To s1.[n65536].End(3).Row
If s1.Cells(i, "p").Value > 0 Then
sat = s1.[a65536].End(3).Row + 1
s1.Cells(sat, "a").Value = s1.Cells(i, "n").Value
s1.Cells(sat, "b").Value = s1.Cells(i, "o").Value
s1.Cells(sat, "c").Value = s1.Cells(i, "p").Value
End If
Next i
MsgBox "Bitti"
Set s1 = Nothing
End Sub

 

[ycimen]

Teşekkürler sayın ripek, beni büyük derttten kurtardınız.