Kesin Mizan Şablonu

[akmes]

Selamlar;

Arkadaşlar Kesin mizan ile ilgili bir şablonum var.Yine bu siteden aldığım bir macro yardımı ile sayfa2 deki A sütünundaki hesap kodlarına göre E,F,G ve H sütunundaki verileri Sayfa 1 deki G sütunundaki hesap karşılıklarının karşısındaki C,D,E ve F sütunlarına aktarılmasını sağlamak, ama bir türlü yapamadım yardımınızı rica ediyorum.Konu ile ilgili örnek ektedir.Şimdiden çok teşekkür ederim.

 

[hamitcan]

Eki inceleyin.

Sub Mizan()
Sayfa2.Select
[c2:f500].ClearContents
Set s1 = Sheets(1)
 With s1
 For i = 2 To [A65536].End(3).Row
 Set a = .Columns("G").Find(Cells(i, 1))
 If Not a Is Nothing Then
 Cells(i, 3) = IIf(.Cells(a.Row, 3) = 0, "", .Cells(a.Row, 3))
 Cells(i, 4) = IIf(.Cells(a.Row, 4) = 0, "", .Cells(a.Row, 4))
 Cells(i, 5) = IIf(.Cells(a.Row, 5) = 0, "", .Cells(a.Row, 5))
 Cells(i, 6) = IIf(.Cells(a.Row, 6) = 0, "", .Cells(a.Row, 6))
 End If
 Next
 End With
End Sub

 

[akmes]

Eki inceleyin.

Sub Mizan()
Sayfa2.Select
[c2:f500].ClearContents
Set s1 = Sheets(1)
 With s1
 For i = 2 To [A65536].End(3).Row
 Set a = .Columns("G").Find(Cells(i, 1))
 If Not a Is Nothing Then
 Cells(i, 3) = IIf(.Cells(a.Row, 3) = 0, "", .Cells(a.Row, 3))
 Cells(i, 4) = IIf(.Cells(a.Row, 4) = 0, "", .Cells(a.Row, 4))
 Cells(i, 5) = IIf(.Cells(a.Row, 5) = 0, "", .Cells(a.Row, 5))
 Cells(i, 6) = IIf(.Cells(a.Row, 6) = 0, "", .Cells(a.Row, 6))
 End If
 Next
 End With
End Sub

Üstadım önce ilginiz için teşekkür ederim.Ama benim istediğim sayfa2 deki verilerin sayfa1 e aktarımı tam tersi olmuş.

 

[hamitcan]

Sub Mizan()
Sayfa1.Select
[c1:f500].ClearContents
Set s1 = Sheets(2)
 With s1
 For i = 2 To [h65536].End(3).Row
 Set a = .Columns(1).Find(Cells(i, "g"))
 If Not a Is Nothing Then
 Cells(i, 3) = IIf(.Cells(a.Row, 5) = 0, "", .Cells(a.Row, 5))
 Cells(i, 4) = IIf(.Cells(a.Row, 6) = 0, "", .Cells(a.Row, 6))
 Cells(i, 5) = IIf(.Cells(a.Row, 7) = 0, "", .Cells(a.Row, 7))
 Cells(i, 6) = IIf(.Cells(a.Row, 8) = 0, "", .Cells(a.Row, 8))
 End If
 Next
 End With
End Sub

 

[akmes]

Sub Mizan()
Sayfa1.Select
[c1:f500].ClearContents
Set s1 = Sheets(2)
 With s1
 For i = 2 To [h65536].End(3).Row
 Set a = .Columns(1).Find(Cells(i, "g"))
 If Not a Is Nothing Then
 Cells(i, 3) = IIf(.Cells(a.Row, 5) = 0, "", .Cells(a.Row, 5))
 Cells(i, 4) = IIf(.Cells(a.Row, 6) = 0, "", .Cells(a.Row, 6))
 Cells(i, 5) = IIf(.Cells(a.Row, 7) = 0, "", .Cells(a.Row, 7))
 Cells(i, 6) = IIf(.Cells(a.Row, 8) = 0, "", .Cells(a.Row, 8))
 End If
 Next
 End With
End Sub

Hocam çok sağolun sizede yordum.Makronuzu denedim olmadı.Daha fazla sizi yormayayım.