IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Code "function" copier tableau [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau membre du Club
    Inscrit en
    Novembre 2009
    Messages
    6
    Détails du profil
    Informations forums :
    Inscription : Novembre 2009
    Messages : 6
    Par défaut Code "function" copier tableau
    Bonjour, je reviens vers vous pour une solution.

    Je suis entrain de faire un classeur excel avec plusieurs feuilles
    Dans une des feuilles (nommé ici DSu) je dois faire des copies du tableau existant dans cette même feuille, mais le problème c'est que je débute dans vba, et que malgré avoir lu votre cours sur vba, je plante.

    Je veux en faire une "function" ou les variables sont de faire autant de copies que le nombre de case pleines dans la colonne "Quantités" de la feuille " plan métrés"

    es ce bien la fonction "Worksheets(index).Copy(Before, After)" mais il manque la variable ".count"

    Si vous avez un peu de temps à me consacrer pour m'aider à réaliser ce code, je vous en remercie d'avance.
    Merci

    Mauli
    Fichiers attachés Fichiers attachés

  2. #2
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut heu.!!
    bonjour mauli bienvenu sur le forum

    j'avoue ne pas bien comprendre ta question

    que veux tu faire exactement copier le sheets("dsu") ou une partie en fonction des lignes remplies

    dans les deux cas il faut copier le sheets("dsu") dans son intégralité pour avoir le tableau en entier avant tout traitement bien sur et ensuite copier toute les lignes remplies

    si ça n'est pas ça que tu cherche a faire donne une explication plus parlante


    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  3. #3
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour
    à défaut de regarder dans le forum, un sujet similaire vient d'être achevé, regarde ici
    Néamoins, rien à faire, je m'ennuie, je me suis permis de préparer un code
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    Sub SousDetail()
    Dim sht As Worksheet
    Dim LastLig As Long, i As Long
    Dim NomFeuille As String
     
    Application.ScreenUpdating = False
    With Sheets("Plan Métrés")
        LastLig = .Cells(Rows.Count, "F").End(xlUp).Row
        For i = 8 To LastLig
            If .Range("F" & i).Value <> "" Then
                NomFeuille = "SD_" & .Range("C" & i).Value
                If NomFeuille <> "SD_" Then
                    On Error Resume Next
                    Set sht = Sheets(NomFeuille)
                    On Error GoTo 0
     
                    If Not sht Is Nothing Then
                        If MsgBox("La feuille " & NomFeuille & " existe déjà, voulez vous la remplacer?", vbYesNo + vbDefaultButton2 + vbCritical) = vbYes Then
                            Application.DisplayAlerts = False
                            sht.Delete
                            Application.DisplayAlerts = True
                            Set sht = Nothing
                        End If
                    End If
     
                    If sht Is Nothing Then
                        Sheets("DSu").Copy Before:=Sheets("DSu")
                        Set sht = ActiveSheet
                        sht.Name = NomFeuille
                        sht.Range("C8").Value = .Range("C" & i).Value
                        sht.Range("D8").Value = .Range("D" & i).Value
                        sht.Range("C10").Value = .Range("E" & i).Value
                        sht.Range("D10").Value = .Range("F" & i).Value
                        Set sht = Nothing
                    End If
                End If
            End If
        Next i
    End With
    End Sub
    Je consens que par ceci, je ne t'ai pas aidé dans ton apprentissage; je reste à l'écoute pour expliquer ces lignes de code. j'estime que tu as au moins les bases fondamentales

  4. #4
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    rebonjour et bonjour mercatog
    si je respecte le souhait de ta question
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
     
     
    Sub copie_multiple_selon_lacol_F()
    Dim derniereligne, e, a, n
    derniereligne = Sheets("Plan métrés").Range("f65536").End(xlUp).Row
     For e = 9 To derniereligne
     If Sheets("Plan métrés").Range("f" & e).Value <> "" Then
     a = a + 1
        Sheets("DSu").Copy After:=Sheets(Sheets.Count)
     
        Sheets(Sheets.Count).Name = "copie de dsu" & a
       End If
       Next
    End Sub
    voila une macro toute simple qui fait ce que tu a demander dans ta question
    ma question est "l'utilité"de ça
    je viens de regarder le code de mercatog et la je trouve un sens mais ça ne correspond pas a ta question

    d'où l'importance de poster une question avec un sens correspondant au plus près du résultat escompté


    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  5. #5
    Nouveau membre du Club
    Inscrit en
    Novembre 2009
    Messages
    6
    Détails du profil
    Informations forums :
    Inscription : Novembre 2009
    Messages : 6
    Par défaut
    Ce que je cherche à faire c'est un code vba(qui deviens alors une fonction "formules", qui resteras dans excel) qui me permet de faire une copie d'une feuille dans cette même feuille part rapport à un nombre donné (ici par les cases remplis de la feuille "plan mètres",colonne "quantité").

    je clic sur Formules/insérer une fonction/Sélectionnez une catégorie/"Mafonction copiertableau" et la une m'ouvre une fenêtre pour choisir le tableau à copier, ou le copier, nombre de copie(part rapport à quoi), quelle sont les valeurs à copier (ici code, désignation, unité et nombre)

    Le hic c'est qu'il doit me faire une copie conforme du tableau mais le titre de chaque tableau doit être en rapport avec le titre du libellé.

    ex ici: le tableau dans DSu est vierge, ensuite en fonction du nombre de libellé y me fait une copie de ce tableau dans cette même feuille, mais chaque copie doit avoir son propre titre.( tableau 0 vierge/ tableau 1; code 01.01.01; désignation Terrassement emprise hérisson...; unité m3; nombre 72,136/ tableau 2; code 01.01.02; designation Traitement termites...; Unité m²; Nombre 430,02/ tableau 3....) ainsi de suite

    Mais pour le code 01.01 terrassement ce n'est qu'un titre alors pas de copie de tableau pour ce libellé.

    Je sais pas si je m'explique bien car j'ai du mal moi même

    PS: le tableau vierge est dans DSu mais lors de l'impression, l'impression doit être faites que sur les tableaux remplis.

    Encore merci de votre aide

    Encore merci de vos réponses si rapide.

    je vais essayer vos codes et c'est vrai que cela m'aide pas du tout dans mon apprentissage mais je vais potasser tout ça et je vous tiens au jus!

    Mauli

  6. #6
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    je comprend mieux ta question


    l'inconvénient ça serai de copier ce même tableau sur la même feuille
    hors dans les deux exemples la copie est faite sur une nouvelle feuille créée dynamiquement
    ça reste plus propre
    dans mon exemple le nom du nouveau tableau est"copie dsu X" tu peut modifier ça de la même manière que mercatog

    name=range ("c"&i).value


    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  7. #7
    Nouveau membre du Club
    Inscrit en
    Novembre 2009
    Messages
    6
    Détails du profil
    Informations forums :
    Inscription : Novembre 2009
    Messages : 6
    Par défaut
    Un GRAND MERCI à vous deux.

    Le code de mercatog est plus complet et corresponds exactement à ce que je voulais.

    Citation Envoyé par patricktoulon Voir le message

    l'inconvénient ça serai de copier ce même tableau sur la même feuille
    hors dans les deux exemples la copie est faite sur une nouvelle feuille créée dynamiquement
    ça reste plus propre
    oui c'est propre mais en réalité il y a plus de 60 tableaux! donc je dois créer un autre classeur specifique au DSu, mais faut que je relie les 2 classeurs!

    Je vais essayer de le faire! et surtout de comprendre ce code
    Impeccable et encore merci.

    Mauli

  8. #8
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Un essai pour créer un classeur par dossier/lot, y ajouter les tableaux sous devis, l'enregistrer dans le même dossier et le fermer
    Dans cet exemple, les cellules D4 et D5 de la feuille "Plan métré" devraient être renseignées.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    Sub SousDetailAutreClasseur()
    Dim wbk As Workbook
    Dim sht As Worksheet
    Dim LastLig As Long, i As Long
    Dim NomFeuille As String, NomClasseur As String, Dossier As String, Lot As String
     
    Application.ScreenUpdating = False
     
    Dossier = ThisWorkbook.Sheets("Plan Métrés").Range("D4").Value
    Lot = ThisWorkbook.Sheets("Plan Métrés").Range("D5").Value
    NomClasseur = ThisWorkbook.Path & "\SD_" & Dossier & "_" & Lot & ".xls"
     
    On Error Resume Next
    Set wbk = Workbooks.Open(NomClasseur)
    On Error GoTo 0
    If wbk Is Nothing Then
        With ThisWorkbook.Sheets("Plan Métrés")
            Set wbk = Workbooks.Add(1)
            LastLig = .Cells(Rows.Count, "F").End(xlUp).Row
            For i = 8 To LastLig
                If .Range("F" & i).Value <> "" Then
                    NomFeuille = "SD_" & .Range("C" & i).Value
                    ThisWorkbook.Sheets("DSu").Copy After:=wbk.Sheets(wbk.Sheets.Count)
                    Set sht = ActiveSheet
                    sht.Name = NomFeuille
                    sht.Range("C8").Value = .Range("C" & i).Value
                    sht.Range("D8").Value = .Range("D" & i).Value
                    sht.Range("C10").Value = .Range("E" & i).Value
                    sht.Range("D10").Value = .Range("F" & i).Value
                    Set sht = Nothing
                End If
            Next i
        End With
        MsgBox "Export sous-devis [" & Dossier & "/ " & Lot & "] terminé"
    Else
        MsgBox "Export sous-devis non effectué, fichier sous devis du dossier [" & Dossier & "/ " & Lot & "] déjà existant"
    End If
    Application.DisplayAlerts = False
    wbk.Sheets(1).Delete
    wbk.Sheets(1).Activate
    wbk.SaveAs NomClasseur
    Application.DisplayAlerts = True
    wbk.Close
    Set wbk = Nothing
    End Sub

  9. #9
    Nouveau membre du Club
    Inscrit en
    Novembre 2009
    Messages
    6
    Détails du profil
    Informations forums :
    Inscription : Novembre 2009
    Messages : 6
    Par défaut
    Merci de toutes vos réponses!

    J'ai essayé ton code (très complet) mais il ne marche pas!
    Mais je me suis mis à VBA, je potasse le bouquin pour trouver pourquoi ton code ne vas pas!

    Au lancement de ton code y me met erreur "9", et la ligne
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Dossier = ThisWorkbook.Sheets("Plan Métrés").Range("D4").Value
    est surligner en jaune!

    merci encore!

    mauli

  10. #10
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Voyons! L'indice n'appartient pas à la sélection
    Vérifie le nom de ta feuille "Plan Métrés" (dans le code et sur la feuille)

+ Répondre à la discussion
Cette discussion est résolue.

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo