Je regarde demain
Option Explicit
Sub test()
Dim Feuille_1 As Worksheet
Dim Feuille_2 As Worksheet
Dim Feuille_3 As Worksheet
Dim Feuille_4 As Worksheet
Dim Feuille_5 As Worksheet
Dim Recap As Worksheet
Dim RecapTargetRow
Dim NewLine
'....
For i = 5 To 500
NewLine = False 'on evalue une nouvelle ligne, donc on réinitialise le flag
If Feuille_1.Cells(i, "B").Value <> "" Then
Recap.Cells(RecapTargetRow, "B").Value = Feuille_1.Cells(i, "B").Value
NewLine = True 'On a copier des données donc il faudra une nouvelle ligne dans target
End If
If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
Next
' pour le tri, je t'invite a essayer l'enregistreur de macro.
End Sub
Sub Import()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim F4 As Worksheet
Dim F5 As Worksheet
Dim R As Worksheet
Dim RecapTargetRow
Dim NewLine
Dim i As Integer
RecapTargetRow = 8 'on commence à remplir la feuille recap depuis la ligne 7 => OK
'SEB => A noter qu'ici il faudra que RecapTargetRow soit égal à la ligne+1 à laquelle il aura fini de copier le tableau 1 avant de copier le tableau 2.
'on affect ta variable Feuille_1 et Recap => OK
Set F1 = Worksheets("CREDIT") 'met le VRAI nom de ta feuille ici => OK
Set F2 = Worksheets("Down_Payments_CREDIT")
Set F3 = Worksheets("DEBIT")
Set F4 = Worksheets("Down_Payments_DEBIT")
Set F5 = Worksheets("SALARIES")
Set R = Worksheets("Recap") 'met le VRAI nom de ta feuille ici => OK
R.Range("B8:J500000").Select
Selection.ClearContents
' Pour chaque ligne dans la feuille 1 (De la ligne 5 jusqu'à la ligne 500) => OK
For i = 5 To 50 'une boucle sur 50 ligne '(totallement inefficace, on pourrait déterminer le nombre de ligne a checker ... mais c'est du niveau 2. => OK
'SEB => Je suis intéréssé si ca peut faire gagner du temps ! Il faudrait qu'il s'arrête à la première ligne vide qu'il détecte en fait...
NewLine = False
'Si colonne B est non nulle => OK
If F1.Cells(i, "B").Value <> "" Then
'on copie la cellule dans recap => OK
R.Cells(RecapTargetRow, "B").Value = F1.Cells(i, "B").Value
NewLine = True
End If
'ici je te laisse essayer colonne D et E => OK J'ESSAYE :)
'SEB => De C à C
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "C").Value = F1.Cells(i, "C").Value
End If
'SEB => De D à D
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "D").Value = F1.Cells(i, "D").Value
End If
'SEB => De H à E
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "E").Value = F1.Cells(i, "H").Value
End If
'SEB => De I à F
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "F").Value = F1.Cells(i, "I").Value
End If
'SEB => De J à G
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "G").Value = F1.Cells(i, "J").Value
End If
'SEB => De L à H
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "H").Value = F1.Cells(i, "L").Value
End If
'SEB => De M à I
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "I").Value = F1.Cells(i, "M").Value
End If
'SEB => De N à J
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "J").Value = F1.Cells(i, "N").Value
End If
If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
Next
'F2
For i = 5 To 50
NewLine = False
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F2.Cells(i, "B").Value
NewLine = True
End If
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "C").Value = F2.Cells(i, "C").Value
End If
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "D").Value = F2.Cells(i, "D").Value
End If
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "E").Value = F2.Cells(i, "F").Value
End If
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "F").Value = F2.Cells(i, "E").Value
End If
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "G").Value = F2.Cells(i, "G").Value
End If
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "I").Value = F2.Cells(i, "I").Value
End If
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "J").Value = F2.Cells(i, "K").Value
End If
If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
Next
'F3
For i = 5 To 50
NewLine = False
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F3.Cells(i, "B").Value
NewLine = True
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "C").Value = F3.Cells(i, "C").Value
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "D").Value = F3.Cells(i, "D").Value
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "E").Value = F3.Cells(i, "H").Value
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "F").Value = F3.Cells(i, "F").Value
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "G").Value = F3.Cells(i, "E").Value
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "H").Value = (F3.Cells(i, "J").Value) * (-1)
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "I").Value = (F3.Cells(i, "K").Value) * (-1)
End If
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "J").Value = F3.Cells(i, "L").Value
End If
If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
Next
'F4
For i = 5 To 50
NewLine = False
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F4.Cells(i, "B").Value
NewLine = True
End If
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "C").Value
End If
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "D").Value = F4.Cells(i, "D").Value
End If
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "E").Value = F4.Cells(i, "H").Value
End If
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "F").Value
End If
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "G").Value = F4.Cells(i, "E").Value
End If
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "I").Value = (F4.Cells(i, "J").Value) * (-1)
End If
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "J").Value = F4.Cells(i, "K").Value
End If
If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
Next
'F5
For i = 5 To 50
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F5.Cells(i, "B").Value
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "C").Value
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "D").Value = F5.Cells(i, "D").Value
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "E").Value = F5.Cells(i, "F").Value
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "I").Value
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "G").Value = F5.Cells(i, "E").Value
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "H").Value = (F5.Cells(i, "J").Value) * (-1)
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "I").Value = (F5.Cells(i, "K").Value) * (-1)
End If
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "J").Value = "Salaries"
End If
RecapTargetRow = RecapTargetRow + 1
Next
R.Range("B7:J500000").Select
ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Add Key:=Range("D8:D500000"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Recap").Sort
.SetRange Range("B7:J500000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub Import()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim F4 As Worksheet
Dim F5 As Worksheet
Dim R As Worksheet
Dim RecapTargetRow
Dim NewLine
Dim i As Integer
RecapTargetRow = 8
Set F1 = Worksheets("CREDIT")
Set F2 = Worksheets("Down_Payments_CREDIT")
Set F3 = Worksheets("DEBIT")
Set F4 = Worksheets("Down_Payments_DEBIT")
Set F5 = Worksheets("SALARIES")
Set R = Worksheets("Recap")
R.Range("B8:J500000").ClearContents
For i = 5 To 8000
NewLine = False
If F1.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F1.Cells(i, "B").Value
R.Cells(RecapTargetRow, "C").Value = F1.Cells(i, "C").Value
R.Cells(RecapTargetRow, "D").Value = F1.Cells(i, "D").Value
R.Cells(RecapTargetRow, "E").Value = F1.Cells(i, "H").Value
R.Cells(RecapTargetRow, "F").Value = F1.Cells(i, "I").Value
R.Cells(RecapTargetRow, "G").Value = F1.Cells(i, "J").Value
R.Cells(RecapTargetRow, "H").Value = F1.Cells(i, "L").Value
R.Cells(RecapTargetRow, "I").Value = F1.Cells(i, "M").Value
R.Cells(RecapTargetRow, "J").Value = F1.Cells(i, "N").Value
NewLine = True
End If
If NewLine Then
RecapTargetRow = RecapTargetRow + 1
End If
Next
For i = 5 To 8000
NewLine = False
If F2.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F2.Cells(i, "B").Value
R.Cells(RecapTargetRow, "C").Value = F2.Cells(i, "C").Value
R.Cells(RecapTargetRow, "D").Value = F2.Cells(i, "D").Value
R.Cells(RecapTargetRow, "E").Value = F2.Cells(i, "F").Value
R.Cells(RecapTargetRow, "F").Value = F2.Cells(i, "E").Value
R.Cells(RecapTargetRow, "G").Value = F2.Cells(i, "G").Value
R.Cells(RecapTargetRow, "I").Value = F2.Cells(i, "I").Value
R.Cells(RecapTargetRow, "J").Value = F2.Cells(i, "K").Value
NewLine = True
End If
If NewLine Then
RecapTargetRow = RecapTargetRow + 1
End If
Next
For i = 5 To 8000
NewLine = False
If F3.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F3.Cells(i, "B").Value
R.Cells(RecapTargetRow, "C").Value = F3.Cells(i, "C").Value
R.Cells(RecapTargetRow, "D").Value = F3.Cells(i, "D").Value
R.Cells(RecapTargetRow, "E").Value = F3.Cells(i, "H").Value
R.Cells(RecapTargetRow, "F").Value = F3.Cells(i, "F").Value
R.Cells(RecapTargetRow, "G").Value = F3.Cells(i, "E").Value
R.Cells(RecapTargetRow, "H").Value = (F3.Cells(i, "J").Value) * (-1)
R.Cells(RecapTargetRow, "I").Value = (F3.Cells(i, "K").Value) * (-1)
R.Cells(RecapTargetRow, "J").Value = F3.Cells(i, "L").Value
NewLine = True
End If
If NewLine Then
RecapTargetRow = RecapTargetRow + 1
End If
Next
For i = 5 To 8000
NewLine = False
If F4.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F4.Cells(i, "B").Value
R.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "C").Value
R.Cells(RecapTargetRow, "D").Value = F4.Cells(i, "D").Value
R.Cells(RecapTargetRow, "E").Value = F4.Cells(i, "H").Value
R.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "F").Value
R.Cells(RecapTargetRow, "G").Value = F4.Cells(i, "E").Value
R.Cells(RecapTargetRow, "I").Value = (F4.Cells(i, "J").Value) * (-1)
R.Cells(RecapTargetRow, "J").Value = F4.Cells(i, "K").Value
NewLine = True
End If
If NewLine Then
RecapTargetRow = RecapTargetRow + 1
End If
Next
For i = 5 To 8000
If F5.Cells(i, "B").Value <> "" Then
R.Cells(RecapTargetRow, "B").Value = F5.Cells(i, "B").Value
R.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "C").Value
R.Cells(RecapTargetRow, "D").Value = F5.Cells(i, "D").Value
R.Cells(RecapTargetRow, "E").Value = F5.Cells(i, "F").Value
R.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "I").Value
R.Cells(RecapTargetRow, "G").Value = F5.Cells(i, "E").Value
R.Cells(RecapTargetRow, "H").Value = (F5.Cells(i, "J").Value) * (-1)
R.Cells(RecapTargetRow, "I").Value = (F5.Cells(i, "K").Value) * (-1)
R.Cells(RecapTargetRow, "J").Value = "Salaries"
End If
RecapTargetRow = RecapTargetRow + 1
Next
R.Range("B7:J500000").Select
ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Add Key:=Range("D8:D500000"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Recap").Sort
.SetRange Range("B7:J500000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
for i = 5 to ?