VBA Faire correspondre un onglet avec un autre (x200)

Le 23/11/2016 à 19:23

Bonsoir à tous,

Dans l'élaboration de mon programme de gestion, j'ai un nouveau problème.

Tout d'abord, voici un bref résumé de mon programme:

J'aimerais obtenir un suivi des paiements de chaque médecin. Tout d'abord, j'encode des données dans un tableau correspondant à un médecin (l'onglet comporte le nom du médecin, ex: "Bartin Claire"). Ensuite, en appuyant sur un bouton comportant une macro, les données se sauvegardent dans la feuille à côté (qui comporte comme nom d'onglet "Bartin Claire synthèse). Après s'être sauvegardées dans le tableau, les données s'effacent du tableau de l'onglet principal du médecin "Bartin Claire" afin de pouvoir réutiliser ce tableau ... Il n'y a pas qu'un seul médecin, et donc il va y avoir un autre onglet avec un autre nom "Defoy Thomas" et "Defoy Thomas synthèse". Ainsi de suite ...

J'ai déjà effectué, grâce à des membres du forum, le tableau comportant les sauvegardes. Cependant, celui-ci se trouve dans le même onglet du médecin. Donc tout se trouve dans l'onglet "Bartin Claire" (voir photos). En d'autres termes, j'ai rajouté des onglets pour y mettre le tableau de sauvegarde afin de se faciliter la tâche pour l'impression.

- Tableau principal de l'onglet "Bartin Claire" où l'on va encodé des données et ensuite vont se supprimer:

- Tableau où se sauvegarde les données (toujours dans l'onglet "Bartin Claire"):

- Tableau où j'aimerais sauvegarder les données au lieu du 2ème tableau de sauvegarde le l'onglet "principal" du médecin (qui sera donc supprimé quand tout ira bien):

Voici le fichier en question:

J'ai encodé quelques données pour que vous sachiez à quoi correspondent les colonnes.

Voici le code VBA pour la sauvegarde du tableau dans le même onglet:

Sub sauvegarde()
    Dim n%, nn%    
    With ActiveSheet
        n = .Range("D52").End(xlUp).Row       
        If n = 1 Then Exit Sub: n = n - 1        
            nn = .Range("D" & .Rows.Count).End(xlUp).Row + 1      
                If Range("L" & nn).Value <> "" Then       
                    nn = nn + 1  
                End If
        Application.ScreenUpdating = False
        .Range("D" & nn).Resize(n).Value = .Range("C2").Resize(n).Value
        .Range("E" & nn).Resize(n).Value = .Range("G2").Resize(n).Value
        .Range("F" & nn).Resize(n).Value = .Range("D2").Resize(n).Value
        .Range("G" & nn).Resize(n).Value = .Range("E2").Resize(n).Value
        .Range("H" & nn).Resize(n).Value = .Range("K2").Resize(n).Value
        .Range("I" & nn).Resize(n).Value = .Range("L2").Resize(n).Value
        .Range("J" & nn).Resize(n).Value = .Range("F2").Resize(n).Value
        .Range("K" & nn).Resize(n).Value = .Range("N2").Resize(n).Value
        .Range("L" & nn).Resize(n).Value = .Range("J2").Resize(n).Value
        .Range("A" & nn) = .Range("T5")
        .Range("C" & nn) = .Range("T3")
        .Range("B" & nn) = .Range("T6")
         nnn = .Range("D" & .Rows.Count).End(xlUp).Row
        .Range("A" & nnn & ":T" & nnn).Borders(xlEdgeBottom).Weight = xlMedium
        .Range("B2:F51").ClearContents
        .Range("H2:L51").ClearContents
        .Range("O2:O51").ClearContents
        .Range("Q2:Q51").ClearContents
        .Range("T5:T6").ClearContents
    End With
End Sub

Que faut-il faire pour faire correspondre ce code dans l'onglet de synthèse. Et que ce soit pareil à chaque fois que j'ajoute une feuille (étant donné qu'il y a que 2 médecins mais il y en aura bien 200 au bout) donc ici ça devra être pareil pour Defoy Thomas et sa synthèse, qu'à chaque fois se soit lier?

Merci de votre aide !

Le 23/11/2016 à 19:41

Bonsoir,

peu-tu reportes ton code sans tes mise en formes ... le code se retrouve en blanc sur blanc sur mon écran soit illisible ...

re,

Tiens inspire toi de cela ...

Sub sauvegarde()
    Dim n%, nn%
    Dim sh as worSheet
    Dim shDest as workSheet

    set sh  = ActiveSheet 'Feuille source
    set shDest = ThisWorkBook.worksheets("Ma feuille synthése")

    With ActiveSheet
        n = .Range("D52").End(xlUp).Row       
        If n = 1 Then Exit Sub: n = n - 1        

'---- Code de calcul nn devient inutile
       'nn = .Range("D" & .Rows.Count).End(xlUp).Row + 1      
        '        If Range("L" & nn).Value <> "" Then       
         '           nn = nn + 1  
          '      End If
        Application.ScreenUpdating = False
        ' Toutes les lignes sous la forme : 
        '.Range("D" & nn).Resize(n).Value = .Range("C2").Resize(n).Value
        'deviennent
        shDest.Range("D2").Resize(n).Value = .Range("C2").Resize(n).Value

???? Il n'y a que moi qui ne vois pas les sources dans cette discussion ???

Le 23/11/2016 à 19:54

Merci pour ta réponse!

Et pour moi, toute la discussion est lisible

Et donc à chaque fois que je vais créer un autre onglet + sa feuille de synthèse, je devrai modifier le nom de la feuille de synthèse ? Ou je dois à chaque fois créer une nouvelle macro et l'affectée au bouton de l'onglet ?

J'en viens donc à modifier le code (ici dans l'onglet Defoy Thomas) :

Sub sauvegarde()
    Dim n%, nn%
        Dim sh As worSheet
        Dim shDest As Worksheet
        Set sh = ActiveSheet  'Feuille source
        Set shDest = ThisWorkbook.Worksheets("Defoy_Thomas_synthèse")
    With ActiveSheet
        n = .Range("D52").End(xlUp).Row
        If n = 1 Then Exit Sub: n = n - 1
        End If
        Application.ScreenUpdating = False
        shDest.Range("D").Resize(n).Value = .Range("C2").Resize(n).Value
        shDest.Range("E").Resize(n).Value = .Range("G2").Resize(n).Value
        shDest.Range("F").Resize(n).Value = .Range("D2").Resize(n).Value
        shDest.Range("G").Resize(n).Value = .Range("E2").Resize(n).Value
        shDest.Range("H").Resize(n).Value = .Range("K2").Resize(n).Value
        shDest.Range("I").Resize(n).Value = .Range("L2").Resize(n).Value
        shDest.Range("J").Resize(n).Value = .Range("F2").Resize(n).Value
        shDest.Range("K").Resize(n).Value = .Range("N2").Resize(n).Value
        shDest.Range("L").Resize(n).Value = .Range("J2").Resize(n).Value
        shDest.Range("A") = .Range("T5")
        shDest.Range("C") = .Range("T3")
        shDest.Range("B") = .Range("T6")
         nnn = .Range("D" & .Rows.Count).End(xlUp).Row
        shDest.Range("A" & nnn & ":T" & nnn).Borders(xlEdgeBottom).Weight = xlMedium
        shDest.Range("B2:F51").ClearContents
        shDest.Range("H2:L51").ClearContents
        shDest.Range("O2:O51").ClearContents
        shDest.Range("Q2:Q51").ClearContents
        shDest.Range("T5:T6").ClearContents
    End With
End Sub

J'ai ce message qui s'affiche en l'exécutant :

Erreur de compilation

Type défini par l'utilisateur non défini

Le 23/11/2016 à 22:29

re,

il manque un k :

  Dim sh As worKSheet

après je comprends pas la question .., tu ne peu pas avoir plusieurs feuilles avec le même nom dans un même classeur..

après tu peu rajouter des paramètres et passer par exemple le nom des feuilles ou l'objet feuille en paramètre à ta procédure que tu met une feuille de code "module standard" de façon à pouvoir l’appeler de chacun de tes boutons..

Sub sauvegarde( stFeuilleSource as string, stFeuilleDest as string )
    Dim n%, nn%
        Dim sh As worSheet
        Dim shDest As Worksheet
        Set sh = ThisWorkbook.Worksheets(stFeuilleSource) 'Feuille source
       Set shDest = ThisWorkbook.Worksheets(stFeuilleDest)
...

et pour les boutons cela donne un truc du genre

sub CommandButton_Click()
 Sauvegarder "Defroy_Thomas","Defroy_Thomas_synthese",
end sub
Rechercher des sujets similaires à "vba correspondre onglet x200"