Makroda düzeltme,

[abbasonline]

Option Explicit
Sub veri_aktar()
Dim a As Long, asi As String
asi = MsgBox("Verileri Aktarayım Mı_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
For a = 2 To Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("xxxx").Range("c3:c35536"), Range("C" & a)) > 0 Then
Cells(a, "B") = WorksheetFunction.Index(Sheets("xxxx").Range("B3:F65536"), WorksheetFunction.Match( _
Range("C" & a).Value, Sheets("xxxx").Range("C3:C65536"), 0), 1)
Cells(a, "C") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:F65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 3)
Cells(a, "F") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:G65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 6)
Cells(a, "D") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:G65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 4)
Cells(a, "E") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:G65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 5)


End If
Next
MsgBox "Veriler Aktarıldı", vbInformation, "Bitiş"
End Sub




yukarıdaki makro (XXXX) sayfasında bulunan verileri diğer sayfanın B sütununa yazdığım veriye denk geleni getirip diğer sayfaya yazıyor

ancak C. sütununa yazdığımı bulup getiriyor, B sütununa bir türlü yapamadım nasıl bir düzeltme yapmam gerekli.

 

[asi_kral]

Merhaba

If WorksheetFunction.CountIf(Sheets("xxxx").Range("c3 :c35536"), Range("B" & a)) > 0 Then
Cells(a, "B") = WorksheetFunction.Index(Sheets("xxxx").Range("B3:F 65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("C3:C65536"), 0), 1)
Cells(a, "C") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:F 65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 3)
Cells(a, "F") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:G 65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 6)
Cells(a, "D") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:G 65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 4)
Cells(a, "E") = WorksheetFunction.Index(Sheets("xxxx").Range("A2:G 65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("xxxx").Range("B2:B65536"), 0), 5)

Şeklinde deneyin. Olmazsa lütfen dosya ekleyin.