Regroupement de donnée dans plusieurs feuilles
Bonjour
Je cherche à regrouper les donnée Extract brut dans les feuilles P10, INTER, ... à partir des code de la feuille regroupe
Ceci afin de ventiler mes comptes dans le but d'exercice comptable.
D'avance merci
Pour l'instant je procède de cette façon mais je voudrais trouver une formule plus courte.
Sub partiel2012()
Application.ScreenUpdating = False
Dim dc, numtrans, num, adabr, diffus, nprod, ean13, liblong, editr, ledit1, typcompo, typrempl, cbar, colisage, dilicom, nop, noffice, prd_spn As String
Sheets("EXTRACT BRUT").Select
Range("E2").Select
While ActiveCell.Value <> ""
dc = ActiveCell.Offset(0, -4)
numtrans = ActiveCell.Offset(0, -3)
num = ActiveCell.Offset(0, -2)
adabr = ActiveCell.Offset(0, -1)
diffus = ActiveCell.Value
nprod = ActiveCell.Offset(0, 1)
ean13 = ActiveCell.Offset(0, 2)
liblong = ActiveCell.Offset(0, 3)
editr = ActiveCell.Offset(0, 4)
ledit1 = ActiveCell.Offset(0, 5)
typcompo = ActiveCell.Offset(0, 6)
typrempl = ActiveCell.Offset(0, 7)
cbar = ActiveCell.Offset(0, 8)
colisage = ActiveCell.Offset(0, 9)
dilicom = ActiveCell.Offset(0, 10)
nop = ActiveCell.Offset(0, 11)
noffice = ActiveCell.Offset(0, 12)
prd_spn = ActiveCell.Offset(0, 13)
Sheets("REGROUPE").Select
Range("B3").Select
While ActiveCell.Value <> ""
If diffus = ActiveCell.Value Then
regroupement = ActiveCell.Offset(0, 1)
GoTo BCL1
Else
ActiveCell.Offset(1, 0).Activate
End If
Wend
BCL1:
Range("C3").Select
While ActiveCell.Value <> ""
If diffus = ActiveCell.Value Then
If regroupement = "P10" Then GoTo P10
If regroupement = "INTER" Then GoTo INTER
If regroupement = "TACH" Then GoTo TACH
Else
ActiveCell.Offset(1, 0).Activate
End If
Wend
P10:
Sheets("P10").Select
Range("E2").Select
If ActiveCell.Value <> "" Then
dc = ActiveCell.Offset(0, -4)
numtrans = ActiveCell.Offset(0, -3)
num = ActiveCell.Offset(0, -2)
adabr = ActiveCell.Offset(0, -1)
diffus = ActiveCell.Value
nprod = ActiveCell.Offset(0, 1)
ean13 = ActiveCell.Offset(0, 2)
liblong = ActiveCell.Offset(0, 3)
editr = ActiveCell.Offset(0, 4)
ledit1 = ActiveCell.Offset(0, 5)