If Sor İle İlgili Bir Soru

[bilal5412]

Merhaba, aşağıdaki gibi bir makro bulunuyor. Bu makro sayfa1deki D sütundaki kodların yanına M2 sutunundan itibaren sayfa3 teki bilgileri getiriyor. Bu makroda sütun ve satırı seç yada sor gibi bir komut eklenebilir mi.

Yani; C3 sütunundaki verilerin sayfa3teki karşılıklarını D3 ten itibaren getir gibi.

Sub xxçeker()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa3")
s1.Select
son = Cells(Rows.Count, 4).End(3).Row
Range("M2", Cells(son, Columns.Count)).ClearContents
For i = 2 To son
For ii = 2 To s2.Cells(Rows.Count, 1).End(3).Row
If s1.Cells(i, 4) = s2.Cells(ii, 1) Then
For iii = 13 To Columns.Count Step 4
If Cells(i, iii) = "" Then
Cells(i, iii).Resize(1, 4).Value = s2.Cells(ii, 2).Resize(1, 4).Value
Exit For
End If
Next iii
End If
Next ii
Next i
Set s1 = Nothing
Set s2 = Nothing
End Sub

Hayırlı Cumalar.

 

[PLİNT]

Merhaba
Örnek dosya üzerinde daha iyi olurdu ama; aşağıdaki gibi bir deneyin.

Sub xxçeker()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa3")
s1.Select
k = InputBox("SÜTUNLARI ÖRNEK GİBİ VE VİRGÜLLÜ YAZINIZ", , "D,M")
If k = Empty Then Exit Sub
m1 = Split(k, ",")(0): m1 = Columns(m1).Column
m2 = Split(k, ",")(1): m2 = Columns(m2).Column
If m1 > m2 Then MsgBox "SÜTUNLARI SIRALI YAZINIZ": Exit Sub
son = Cells(Rows.Count, m1).End(3).Row + 1
Range(Cells(2, m2), Cells(son, Columns.Count)).ClearContents
For i = 2 To son
For ii = 2 To s2.Cells(Rows.Count, 1).End(3).Row
If s1.Cells(i, m1) = s2.Cells(ii, 1) Then
For iii = m2 To Columns.Count Step 4
If Cells(i, iii) = "" Then
Cells(i, iii).Resize(1, 4).Value = s2.Cells(ii, 2).Resize(1, 4).Value
Exit For
End If
Next iii
End If
Next ii
Next i
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[bilal5412]

Merhaba, desteğiniz için teşekkürler. Sorum çözülmüştür. Allah razı olsun.

Sub xxçeker()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa3")
s1.Select
k = InputBox("SÜTUNLARI ÖRNEK GİBİ VE VİRGÜLLÜ YAZINIZ", , "D,M")
If k = Empty Then Exit Sub
m1 = Split(k, ",")(0): m1 = Columns(m1).Column
m2 = Split(k, ",")(1): m2 = Columns(m2).Column
If m1 > m2 Then MsgBox "SÜTUNLARI SIRALI YAZINIZ": Exit Sub
son = Cells(Rows.Count, m1).End(3).Row
Range(Cells(2, m1), Cells(son, Columns.Count)).ClearContents
For i = 2 To son
For ii = 2 To s2.Cells(Rows.Count, 1).End(3).Row
If s1.Cells(i, m1) = s2.Cells(ii, 1) Then
For iii = m2 To Columns.Count Step 4
If Cells(i, iii) = "" Then
Cells(i, iii).Resize(1, m1).Value = s2.Cells(ii, 2).Resize(1, m1).Value
Exit For
End If
Next iii
End If
Next ii
Next i
Set s1 = Nothing
Set s2 = Nothing
End Sub

[/QUOTE]