Code "function" copier tableau

Version imprimable

05/09/2010, 15h02
mauli

1 pièce(s) jointe(s)

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
05/09/2010, 15h25
patricktoulon

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

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:

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

rebonjour et bonjour mercatog
si je respecte le souhait de ta question
Code:

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

05/09/2010, 16h18
mauli

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
05/09/2010, 16h35
patricktoulon

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
05/09/2010, 16h46
mauli

Un GRAND MERCI à vous deux.

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

Citation:

Envoyé par patricktoulon

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!8O 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

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:

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

06/09/2010, 20h04
mauli

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:

Dossier = ThisWorkbook.Sheets("Plan Métrés").Range("D4").Value

est surligner en jaune!

merci encore!

mauli
06/09/2010, 20h09
mercatog

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)