Makro yardımıyla satırlardan sütunlara bilgi taşımak

[bedri41]

İlişikteki örnek dosyamın içerisinde de açıkladığım, 2 sayfadan oluşan bir dosyam var birinci sayfada yan yana yazılı verileri makro yardımıyla diğer sayfadaki tabloya taşımak istiyorum. Forumdaki benzer konularla ilgili pek çok örneği inceledim ancak benim yampak istediğim gibi bir örnek bulamadım.
Yardımlarınız için şimdiden teşekkür ederim

 

[fedeal]

Merhaba,

Option Explicit
Private Sub CommandButton1_Click()
Dim c, t As Integer
Dim ARA As Variant
Set ARA = Sheets("LM Genius").Range("A1:a65000").Find(TextBox1, LookIn:=xlValues)
If Not ARA Is Nothing Then

 Sheets("0").Cells(10, "b").Value = CDbl(Sheets("LM Genius").Cells(ARA.Row + 4, 5).Value) / 2
 Sheets("0").Cells(10, "g").Value = CDbl(Sheets("LM Genius").Cells(ARA.Row + 4, 6).Value) / 2
 Sheets("0").Cells(10, "l").Value = CDbl(Sheets("LM Genius").Cells(ARA.Row + 4, 7).Value) / 2
 Sheets("0").Cells(10, "q").Value = CDbl(Sheets("LM Genius").Cells(ARA.Row + 4, 8).Value) / 2
c = 11
For t = 5 To 36 Step 4
 Sheets("0").Cells(c, "b").Value = Sheets("LM Genius").Cells(ARA.Row + 4, t).Value
 Sheets("0").Cells(c, "g").Value = Sheets("LM Genius").Cells(ARA.Row + 4, t + 1).Value
 Sheets("0").Cells(c, "l").Value = Sheets("LM Genius").Cells(ARA.Row + 4, t + 2).Value
 Sheets("0").Cells(c, "q").Value = Sheets("LM Genius").Cells(ARA.Row + 4, t + 3).Value
 c = c + 1
 Next
 End If
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

deneyin istediginiz bumu?

 

[bedri41]

Sayın Fedeal,
Yardımlarınız için çok teşekkür ederim. Vermiş olduğunuz kodlar üzerinde bende biraz çalışarak tablolarımı oluşturmaya başladım. Ancak "A4" hanesine ilgili ilin adını birtürlü getiremedim. Yeni dosyayı ilişikte gönderiyorum.
Bu konuda yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

 

[fedeal]

Merhaba,

Sheets("0").Cells(4, "a").Value = Sheets("LM Genius").Cells(ARA.Row + 1, 1).Value

bu işinizi görecektir,iyi çalışmalar.

 

[bedri41]

Çok teşekkürler

 

[bedri41]

Sayın Fedeal,
Bu makroyla ilgili bir şey daha sormak isterim makrodaki "For t = 5 To 36 Step 4" deki Step 4 Userform üzerine açılacak bir textbox ile kullanıcının belirleyeceği rakamlar olabilirmi ? Farklı dosyalarda bu rakam 3, 6 veya 7 olabiliyor.
teşekkürler..

 

[fedeal]

dim w as Integer

bu üst kısma

w=textbox1.text
if w="" then w=4
For t = 5 To 36 Step w

bunda ilgili yere kopyalayın textbox boş olursa hata vermemesi için 4 olarak işleyecek.deneyin sorun olursa düzeltiriz.(kırmızı olan textbox numarasını ayarlayın)

 

[bedri41]

Sayın Fedeal,
Yardımlarınız için gerçekten çok teşekkür ederim.Son verdiğiniz kodlarıda uygulayarak sorunu hallettim.
Şimdi farklı bir tablo için yine yardıma ihtiyacım var. Aynı veri tabanını kullanarak aşağıdaki kodlarla birinci satırı yazdırıyorum, veri sayfasında TextBox1 e uyan ikinci veriyi de bir alt satıra yazdırmak için nasıl bir ilave yapmam gerekir.

Option Explicit
Private Sub CommandButton1_Click()
Dim c, w As Integer
Dim ARA As Variant
Set ARA = Sheets("LM Genius").Range("A1:a65000").Find(TextBox1, LookIn:=xlValues)
If Not ARA Is Nothing Then

Sheets("1").Cells(14, "b").Value = Sheets("LM Genius").Cells(ARA.Row, 1).Value
Sheets("1").Cells(14, "a").Value = Sheets("LM Genius").Cells(ARA.Row + 1, 1).Value
Sheets("1").Cells(14, "c").Value = Sheets("LM Genius").Cells(ARA.Row + 2, 1).Value
c = 14
w = TextBox6.Text
Sheets("1").Cells(c, "d").Value = Sheets("LM Genius").Cells(ARA.Row + 3, 5).Value
Sheets("1").Cells(c, "e").Value = Sheets("LM Genius").Cells(ARA.Row + 3, w + 5).Value
Sheets("1").Cells(c, "f").Value = Sheets("LM Genius").Cells(ARA.Row + 3, w + 12).Value
End If
End Sub

Private Sub CommandButton2_Click()
Unload UserForm2
End Sub

Ayrıca, bu bittikten sonra TextBox2, TextBox3, TextBox4 ve TextBox5 sorgularınıda yaparak alt satırlara devam etmesi gerekiyor.

Yardımlarınız için şimdiden çok teşekkürler

 

[bedri41]

Yukarıdaki soruma bu şekilde cevap alamayacağımı düşündüğüm için içerisine gerekli açıklamalarıda yazdığım örnek dosyayı ekliyorum.
Yardımcı olacak ve yol gösterecek arkadaşlara şimdiden çok teşekkür ederim.

 

[bedri41]

Arkadaşlar,
Soruların tamamına olmasada, Textbox1 e uyan ikinci bir veriyi buldurup bir alt satıra yazdırmaya yardımcı olabilirmisiniz ?
Teşekkürler