Transfert de ligne de feuille à feuille Excel
Bonjour Messieurs, Mesdames
Je me permets de publier sur ce forum pour améliorer mon quotidien au travail aha.
En effet je travaille sur un très important fichier dont j'aimerais améliorer la lisibilité.
C'est un fichier client (donc je ne pourrai pas le publier malheureusement)
Cependant je peux résumer de manière simple:
J'ai des demandes clients qui dépendent de plusieurs filiales différentes. J'ai donc un tableau avec plusieurs lignes (une par demande) et des colonnes clients, j'ai ajouté une dernière colonne ou j'ai fait une recherche V par rapport à un autre fichier pour mettre les filiales correspondantes.
Mais voila mon but serait d'avoir une feuille séparé pour chaque filiale, et au lieu de le faire à la main en copiant (laborieux..). J'aimerais qu'en fonction du nom de la filiale la ligne correspondante se copie sur la feuille attribué à la filiale (de manière automatique)
Par exemple sur ma feuille principale :
Filiale A
Filiale B
Feuile 2
Toutes les lignes correspondantes aux filiales A
Feuille 3
Toutes les lignes correspondantes aux filiales B
Voila ce que je te propose, a toi de remplacer les noms qui conviennent et de mettre le bon nombre de colonnes etc...
Sub transfert ()
Dim CurrentWorkbook As Workbook
Dim Data As Worksheet 'Equivaut à la feuille 1'
Dim FilialeA As Worksheet ' feuille 2'
Dim FilialeB As Worksheet 'Feuille 3'
Dim i As Ingeger, j As Integer, m As Integer
Set CurrentWorkbook = ThisWorkbook
Set Data = CurrentWorkbook.Worksheets.Item("Feuille1") 'ou le nom de ta feuille 1
Set FilialeA = CurrentWorkbook.Worksheets.Item("Feuille2")
Set FilialeB = CurrentWorkbook.Worksheets.Item("Feuille3")
i = 1
j = 1
m = 1
Do Until Data.Cells(1+i, la colonne où se trouve les Filiales) = ""
If Data.Cells(1 +i, n°colonne des filiales) = "Filiale A"
FilialeA.cells(0+j,1) =Data.Cells(0+i,1)
FilialeA.cells(0+j,2) =Data.Cells(0+i,2)
FilialeA.cells(0+j,3) =Data.Cells(0+i,3)
'pour toutes tes colonnes'
j = j+1
Else
FilialeB.Cells(0+m,1) = Data.Cells(0+i,1)
'pour les colonnes'
m = m+1
End If
i=i+1
Loop
End sub
Bonjour
Tout d'abord merci de votre aide !
J'ai essayé de rentrer cette macro ce matin en changeant les codes par rapport à mes fichiers, cependant je n'y connais vraiment rien donc j'ai essayé de me débrouiller et ça ne marche pas.. Voici le code que j'ai fait :
Sub transfert()
Dim CurrentWorkbook As Workbook
Dim Data As Worksheet 'Contacts'
Dim FilialeA As Worksheet 'Ouest'
Dim FilialeB As Worksheet 'Est'
Dim b As Ingeger, c As Integer, d As Integer, e As Ingeger, f As Integer, g As Integer, h As Ingeger, i As Integer, j As Integer, k As Ingeger, l As Integer, m As Integer, n As Ingeger, o As Integer, p As Integer, q As Ingeger, r As Integer, s As Integer, t As Integer
Set CurrentWorkbook = ThisWorkbook
Set Data = CurrentWorkbook.Worksheets.Item("Contacts")
Set Ouest = CurrentWorkbook.Worksheets.Item("Ouest")
Set Est = CurrentWorkbook.Worksheets.Item("Est")
a = 1
b = 1
c = 1
d = 1
e = 1
f = 1
g = 1
h = 1
i = 1
j = 1
k = 1
l = 1
m = 1
n = 1
o = 1
p = 1
q = 1
r = 1
s = 1
t = 1
Do Until Data.Cells(1 + t) = "Knauf Ouest"
If Data.Cells(1+t)= "Knauf Ouest"
Ouest.Cells(0 + c, 1) = Data.Cells(0 + b, 1)
Ouest.Cells(0 + d, 2) = Data.Cells(0 + b, 2)
Ouest.Cells(0 + e, 3) = Data.Cells(0 + b, 3)
Ouest.Cells(0 + f, 1) = Data.Cells(0 + b, 4)
Ouest.Cells(0 + g, 2) = Data.Cells(0 + b, 5)
Ouest.Cells(0 + h, 3) = Data.Cells(0 + b, 6)
Ouest.Cells(0 + i, 1) = Data.Cells(0 + b, 7)
Ouest.Cells(0 + j, 2) = Data.Cells(0 + b, 8)
Ouest.Cells(0 + k, 3) = Data.Cells(0 + b, 9)
Ouest.Cells(0 + l, 1) = Data.Cells(0 + b, 10)
Ouest.Cells(0 + m, 2) = Data.Cells(0 + b, 11)
Ouest.Cells(0 + n, 3) = Data.Cells(0 + b, 12)
Ouest.Cells(0 + o, 1) = Data.Cells(0 + b, 13)
Ouest.Cells(0 + p, 2) = Data.Cells(0 + b, 14)
Ouest.Cells(0 + q, 3) = Data.Cells(0 + b, 15)
Ouest.Cells(0 + r, 1) = Data.Cells(0 + b, 16)
Ouest.Cells(0 + s, 2) = Data.Cells(0 + b, 17)
Ouest.Cells(0 + t, 3) = Data.Cells(0 + b, 18)
c = c + 1
Else
Est.Cells(0 + c, 1) = Data.Cells(0 + b, 1)
Est.Cells(0 + d, 2) = Data.Cells(0 + b, 2)
Est.Cells(0 + e, 3) = Data.Cells(0 + b, 3)
Est.Cells(0 + f, 1) = Data.Cells(0 + b, 4)
Est.Cells(0 + g, 2) = Data.Cells(0 + b, 5)
Est.Cells(0 + h, 3) = Data.Cells(0 + b, 6)
Est.Cells(0 + i, 1) = Data.Cells(0 + b, 7)
Est.Cells(0 + j, 2) = Data.Cells(0 + b, 8)
Est.Cells(0 + k, 3) = Data.Cells(0 + b, 9)
Est.Cells(0 + l, 1) = Data.Cells(0 + b, 10)
Est.Cells(0 + m, 2) = Data.Cells(0 + b, 11)
Est.Cells(0 + n, 3) = Data.Cells(0 + b, 12)
Est.Cells(0 + o, 1) = Data.Cells(0 + b, 13)
Est.Cells(0 + p, 2) = Data.Cells(0 + b, 14)
Est.Cells(0 + q, 3) = Data.Cells(0 + b, 15)
Est.Cells(0 + r, 1) = Data.Cells(0 + b, 16)
Est.Cells(0 + s, 2) = Data.Cells(0 + b, 17)
Est.Cells(0 + t, 3) = Data.Cells(0 + b, 18)
c = c + 1
End If
b = b + 1
Loop
End Sub
Je met le fichier excel en changeant les données clients pour aider peut être à trouver une solution... Je vous rmercie de votre c'est très aimable :