Rapport de message :*
 

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,