Copier des données en fonction nom Onglet

Le 12/01/2016 à 14:35

Bonjour,

J'ai un problème avec mon code (je suis débutante en VBA). Je veux améliorer un fichier surlequel je travaille/

En fait j'utilise le fichier source F2. En fonction du libelllé de la colonne L je veux qu'il me mette les données correspondant dans le bon onglet via le nom.

Je vous remercie par avance de votre aide.

Veuillez trouver ci dessous le code et en PJ le fichier

Dim J As Long, Nblg As Long, Ligne As Long
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet, F4 As Worksheet, F5 As Worksheet, F6 As Worksheet, F7 As Worksheet, F8 As Worksheet
Dim Cel As Range

Sub Macro2_Ordre()
Dim Lgdep As Long
Dim libelle
Dim I As Integer

  Application.ScreenUpdating = False

  libelle = Array("Pré saisie")

  Set F1 = Sheets("Pré saisi")
  Set F2 = Sheets("Exrait macro1")
  Set F3 = Sheets("AF")
  Set F4 = Sheets("FD")
  Set F5 = Sheets("KD")
  Set F6 = Sheets("NT")
  Set F7 = Sheets("SGB")
  Set F8 = Sheets("VS")

  ' Si de lignes filtrées on les affiche. en fait le code ci dessous enlève les filtres mais il ne les remet pas. Peux tu m'aider à l'améliorer
  With F1
    If .FilterMode = True Then .ShowAllData
  End With

  With F1.Range("A2:M3000")
  .ClearContents
    .Font.Size = 10
    .Font.Bold = False
  End With

  Ligne = 2

  'je veux qu'il me classe toutes les lignes dont la colonne L commence par pré saisi
  'dans l'onglet pré saisi

For J = 2 To F2.Range("A" & Rows.Count).End(xlUp).Row
    If UCase(Trim(F2.Range("L" & Cel.Row))) = UCase("Pré saisie*") Then
            F1.Range("A" & Ligne) = F2.Range("A" & Cel.Row)
            F1.Range("B" & Ligne) = F2.Range("B" & Cel.Row)
            F1.Range("C" & Ligne) = F2.Range("C" & Cel.Row)
            F1.Range("D" & Ligne) = F2.Range("D" & Cel.Row)
            F1.Range("E" & Ligne) = F2.Range("E" & Cel.Row)
        Ligne = Ligne + 1

  End If
  'puis les lignes dont la colonne L <> "Pré saisi" et la colonne J= "VS"
  'dans l'onglet VS
  Next J
  For J = 2 To F2.Range("A" & Rows.Count).End(xlUp).Row
    If UCase(Trim(F2.Range("L" & Cel.Row))) <> UCase("Pré saisie*") And _
    UCase(F2.Range("J" & Cel.Row)) = "AF" Then
            F3.Range("A" & Ligne) = F2.Range("A" & Cel.Row)
            F3.Range("B" & Ligne) = F2.Range("B" & Cel.Row)
            F3.Range("C" & Ligne) = F2.Range("C" & Cel.Row)
            F3.Range("D" & Ligne) = F2.Range("D" & Cel.Row)
            F3.Range("E" & Ligne) = F2.Range("E" & Cel.Row)
        Ligne = Ligne + 1

  End If

End Sub

[code]

[/code]

15macro-2-ordres-icone.xlsm (169.74 Ko)
Le 12/01/2016 à 14:48

Bonjour hamynaa

hamynaa a écrit :

'puis les lignes dont la colonne L <> "Pré saisi" et la colonne J= "VS" 'dans l'onglet VS

et je suppose que si J= AF alors onglet AF, si J= SGB alors onglet SGB... ?

Le 12/01/2016 à 15:01

Bonjour Andrea,

C'est exact, je veux qu'il me met tous les pré saisis dans l'onglet présais quelque soit la personne qui est affectée (VS, AF,...)

Puis il met met toutes les données ordre icone c'est à dire L <> différent de pré saisi en fonction des personnes affectées.

les donnees VS dans l'onglet VS, les données AF dans l'onglet AF,....

Merci de votre aide précieuse

Le 12/01/2016 à 16:01

(re)

Voici un petit bout de code rapide "Repartition dans le module 4" pour que tu puisses voir le principe

Il ne fonctionne pas "tout à fait" car il y a des erreurs dans le tableau "Extrait macro1" quelques onglets d'affectation n'existent pas et je n'ai pas voulu changer les saisies ou ajouter de nouvel onglet

PS pour pouvoir testéj'ai quand même changer l'onglet SGB en SBG (cf colonne AFFECTE A)

NB/ Exceptionnellement mon code n'est pas commenté, si tu as du mal à comprendre ce qui s'y passe fais moi signe !

13essai-rapide.xlsm (177.43 Ko)
Le 13/01/2016 à 18:33

Bonjour Andréa,

Merci beaucoup pour ton code !

C'est effectivement ce que je voulais faire mais je me rends compte que j'ai perdu les bases que j'avais acquis en VBA.

Je travaillle dessus depuis laprés midi, mais à chaque fois que je fais des modifications çà ne fonctionne plus.

Est ce que tu pôurras me rajouter des commentaires please.

Je t'ai mis des commentaires dans le code ci dessous

Merci encore

sub Repartition()
Dim ligDeb, colDeb As Integer
Dim ligFin, colFin As Integer
Dim ligCpt As Integer

Dim i As Integer

Dim tabGlobal()
Dim tabCpt(1 To 7)

    ligDeb = 2
    colDeb = 1
    Cells(2, 1).Select
    Selection.End(xlDown).Select
    ligFin = ActiveCell.Row
    colFin = 13

    tabGlobal = Range(Cells(ligDeb, colDeb), Cells(ligFin, colFin))

    For i = 1 To 7
        tabCpt(i) = 2
    Next

    For ligCpt = 1 To UBound(tabGlobal, 1)
    'Génial ça m'a remplit toutes mes colonnes de l'onglet présaisi
        If Left(tabGlobal(ligCpt, 12), 3) = "Pré" Then
            Worksheets("Pré saisi").Cells(tabCpt(1), 1) = tabGlobal(ligCpt, 1)
            Worksheets("Pré saisi").Cells(tabCpt(1), 2) = tabGlobal(ligCpt, 2)
            Worksheets("Pré saisi").Cells(tabCpt(1), 3) = tabGlobal(ligCpt, 3)
            Worksheets("Pré saisi").Cells(tabCpt(1), 4) = tabGlobal(ligCpt, 4)
            Worksheets("Pré saisi").Cells(tabCpt(1), 5) = tabGlobal(ligCpt, 5)
            Worksheets("Pré saisi").Cells(tabCpt(1), 6) = tabGlobal(ligCpt, 6)
            Worksheets("Pré saisi").Cells(tabCpt(1), 7) = tabGlobal(ligCpt, 7)
            Worksheets("Pré saisi").Cells(tabCpt(1), 8) = tabGlobal(ligCpt, 8)
            Worksheets("Pré saisi").Cells(tabCpt(1), 9) = tabGlobal(ligCpt, 9)
            Worksheets("Pré saisi").Cells(tabCpt(1), 10) = tabGlobal(ligCpt, 10)
            Worksheets("Pré saisi").Cells(tabCpt(1), 11) = tabGlobal(ligCpt, 11)
            Worksheets("Pré saisi").Cells(tabCpt(1), 12) = tabGlobal(ligCpt, 12)
            '...
            tabCpt(1) = tabCpt(1) + 1
        Else
            Select Case tabGlobal(ligCpt, 10)
                Case "AF"
                    cpt = 2
                Case "FD"
                   cpt = 3
                Case "KD"
                    cpt = 4
                Case "NT"
                    cpt = 5
                Case "SBG"
                    cpt = 6
                Case "VS"
                    cpt = 7
            End Select
            'à partir de la ligne suivante, erreur d'exécution 9, l'indice n'appartient pas à la selection
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 1) = tabGlobal(ligCpt, 1)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 2) = tabGlobal(ligCpt, 2)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 3) = tabGlobal(ligCpt, 3)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 4) = tabGlobal(ligCpt, 4)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 5) = tabGlobal(ligCpt, 5)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 6) = tabGlobal(ligCpt, 6)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 7) = tabGlobal(ligCpt, 7)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 8) = tabGlobal(ligCpt, 8)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 9) = tabGlobal(ligCpt, 9)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 10) = tabGlobal(ligCpt, 10)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 11) = tabGlobal(ligCpt, 11)
            Worksheets(tabGlobal(ligCpt, 10)).Cells(tabCpt(cpt), 12) = tabGlobal(ligCpt, 12)

            tabCpt(cpt) = tabCpt(cpt) + 1
        End If
    Next

End Sub
Le 13/01/2016 à 18:53

(re)

Si l'indice plante alors que tu es sur une affectation "PS" c'est normal ! Il n'y a pas d'onglet "PS" d'après mon exemple en tout cas !

il faut donc

  1. l'ajouter
  2. dans
    Dim tabCpt(1 To 7)
    For i = 1 To 7
    tabCpt(i) = 2
    Next
    il faut changer les 7 en 8 pcq'il y a un onglet de plus
  3. il faut ajouter un "CAS" à Select Case tabGlobal(ligCpt, 10)
    qui sera Case "PS".. cpt = 8 pcq c'est le 8ème obglet

normalement avec ces modifs cela devrait fonctionner !

Le 14/01/2016 à 10:36

Hello Andréa,

Merci beaucoup pour ta patience

Ca marche nickel.

A bientot dans les aventures des nuls en VBA

Le 14/01/2016 à 10:46

Bonjour

Heureux d'avoir contribué à la résolution de ton problème, et d'avoir rafraîchi tes méninges Excelesque !

à bientôt...

Rechercher des sujets similaires à "copier donnees fonction nom onglet"