DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub aktar()
sat = WorksheetFunction.CountA(Worksheets("RAPOR").Range("A4:A65000")) + 4
For r = 15 To Worksheets("TABELA(SİYAH) ").[A65536].End(3).Row
aranan1 = Sheets("TABELA(SİYAH) ").Cells(r, 1).Value
say3 = 0
say4 = 0
say5 = 0
say6 = 0
say7 = 0
say8 = 0
say9 = 0
If Sheets("TABELA(SİYAH) ").Cells(r, 10).Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("TABELA(SİYAH) ").Range("A15:A" & r), aranan1) = 1 Then
For i = r To Worksheets("TABELA(SİYAH) ").[A65536].End(3).Row
aranan2 = Sheets("TABELA(SİYAH) ").Cells(i, 1).Value
If aranan2 = aranan1 Then
say3 = say3 + CDbl(Sheets("TABELA(SİYAH) ").Cells(i, 3).Value)
say4 = say4 + CDbl(Sheets("TABELA(SİYAH) ").Cells(i, 4).Value)
say5 = say5 + CDbl(Sheets("TABELA(SİYAH) ").Cells(i, 5).Value)
say6 = say6 + CDbl(Sheets("TABELA(SİYAH) ").Cells(i, 6).Value)
say7 = say7 + CDbl(Sheets("TABELA(SİYAH) ").Cells(i, 7).Value)
say8 = say8 + CDbl(Sheets("TABELA(SİYAH) ").Cells(i, 8).Value)
say9 = say9 + CDbl(Sheets("TABELA(SİYAH) ").Cells(i, 9).Value)
End If
Next i
Sheets("RAPOR").Cells(sat, 1).Value = Sheets("TABELA(SİYAH) ").Cells(2, 2).Value
Sheets("RAPOR").Cells(sat, 2).Value = Sheets("TABELA(SİYAH) ").Cells(r, 1).Value
Sheets("RAPOR").Cells(sat, 4).Value = say3
Sheets("RAPOR").Cells(sat, 5).Value = say4
Sheets("RAPOR").Cells(sat, 6).Value = say5
Sheets("RAPOR").Cells(sat, 7).Value = say6
Sheets("RAPOR").Cells(sat, 8).Value = say7
Sheets("RAPOR").Cells(sat, 9).Value = say8
Sheets("RAPOR").Cells(sat, 10).Value = say9
sat = sat + 1
End If
End If
Next r
MsgBox "işlem tamam"
End Sub