Re: RECHERCHE AUTOMATIQUE D'UNE FEUILLE A UNE AUTRE |
Titre du sujet : Re: RECHERCHE AUTOMATIQUE D'UNE FEUILLE A UNE AUTRE par myDearFriend! le 11/01/2016 19:52:58 Bonsoir naka1oneshot, le Forum,
Je te propose le code VBA suivant, actionné par un bouton dans la feuille "CLIENT" :
DANS UN MODULE DE CODE STANDARD (Ex : Module1) Option Explicit '--------------------------------------------------------------------- ' Auteur : Didier FOURGEOT (myDearFriend!) ' Site : www.mdf-xlpages.com ' Date : Janvier 2016 '--------------------------------------------------------------------- Sub Repartition() Dim TabTemp As Variant Dim FCible As Worksheet Dim NomBateau$ Dim L As Long, LignCible As Long Dim C As Integer 'Mémorise le tableau de données "CLIENT" dans une variable TabTemp With Sheets("CLIENT") 'N° dernière ligne du tableau ? L = DernLign(Sheets("CLIENT"), 1) 'Le tableau commence à la ligne 9 et se termine en colonne 9 TabTemp = .Range(.Cells(9, 1), .Cells(L, 9)).Value End With 'Pour chaque ligne du tableau For L = 1 To UBound(TabTemp, 1) NomBateau = TabTemp(L, 7) On Error Resume Next Set FCible = Sheets(NomBateau) On Error GoTo 0 'La feuille existe ? If Not FCible Is Nothing Then 'Les données commencent ligne 16, colonnes 8 à 15 With FCible 'Première ligne disponible dans la feuille Cible LignCible = DernLign(FCible, 8) + 1 'On recopie toutes les colonnes sauf la 7e For C = 1 To 9 Select Case C Case 1 To 6 .Cells(LignCible, C + 7).Value = TabTemp(L, C) Case 8 To 9 .Cells(LignCible, C + 6).Value = TabTemp(L, C) End Select Next C End With Set FCible = Nothing End If Next L MsgBox "Répartition réalisée. OK !" End Sub Private Function DernLign(F As Worksheet, colDepart As Integer) As Long With F DernLign = .Cells(.Rows.Count, colDepart).End(xlUp).Row End With End Function En pièce jointe, ton fichier adapté en conséquence.
En espérant t'avoir dépanné...
Bien cordialement, |
Forums