Faire un copier coller avec 1 condition

Le 27/02/2014 à 12:13

Bonjour a tous

mon projet et dossier se décomposent de la façon suivante

j ai un dossier avec 3 fichiers :

1 classeur avec une feuille panneau de contrôle avec une feuille ou sont mes variantes (pour la duplication)

1 classeur modèle nommée ddpp71 qui doit se dupliquer

1 classeur nomme ddi qui possède 1 feuille nommé v2 qui me serre de "base de donnée"

mon projet

à partir d un bouton de contrôle dupliquer le classeur modelé ( partie réussi)

puis que le fichier DDI s ouvre ( ligne de code ok)

dans le fichier DDI feuille V2 je souhaite copier les élément relatif Range("K3:AK??").copy mais avec une condition le nom du dossier créer ( la sa bloque )

et qui me recopie cette partie dans le classeur nouvellement créer dans la feuille collaborateurs range ( b3:ab??)

la premier partie de mon code la voici pour dupliquer les dossiers

  Private Sub CommandButton2_Click()
Dim C As Variant
Dim dossierEnCours As String
dossierEnCours = ThisWorkbook.Path
Workbooks.Open Filename:=dossierEnCours & "\ddpp71.xlsx"

Application.ScreenUpdating = False

For Each C In ThisWorkbook.Sheets("liste").Range("A1:A22")
ActiveWorkbook.SaveAs Filename:=dossierEnCours & "\" & C & ".xlsx"

Next

ThisWorkbook.Sheets("liste").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

la copie simple

la voici

Dim dossierEnCours As String
dossierEnCours = ThisWorkbook.Path
Workbooks.Open Filename:=dossierEnCours & "\ddpp72.xlsx"
Workbooks.Open Filename:=dossierEnCours & "\ddi.xlsx"
Workbooks("ddi.xlsx").Sheets("v2").Range("K3:AK33").Copy
Workbooks("DDPP72.xlsx").Sheets("collaborateurs").Range("b5:ab33").PasteSpecial Paste:=xlPasteValues

le renvoie dans le fichier nouvellement créé, je n ai pas trouvé le code pour la mise en place d une condition avec IF then afin de copier coller l ensemble des élément de la base suivant le nom du nouveau dossier créé

merci pour votre aide

Le 27/02/2014 à 14:04

Bonjour

Sans tes fichiers pas facile à comprendre

A essayer

Private Sub CommandButton2_Click()
Dim WbModel As Workbook, WbDdi As Workbook
Dim C As Variant
Dim DossierEnCours As String

  Application.ScreenUpdating = False

  DossierEnCours = ThisWorkbook.Path
  Set WbModel = Workbooks.Open(Filename:=DossierEnCours & "\ddpp71.xlsx")
  Set WbDdi = Workbooks.Open(Filename:=DossierEnCours & "\ddi.xlsx")

  WbDdi.Sheets("v2").Range("K3:AK33").Copy
  WbModel.Sheets("collaborateurs").Range("B3").PasteSpecial Paste:=xlPasteValues

  For Each C In ThisWorkbook.Sheets("liste").Range("A1:A22")
    WbModel.SaveAs Filename:=DossierEnCours & "\" & C & ".xlsx"
  Next C

  WbModel.Close savechanges:=False
  WbDdi.Close savechanges:=False
End Sub
Le 27/02/2014 à 14:14

merci pour ce coup de pousse j ai fait évoluer ma macro mais ce n est pas encore cela

Private Sub CommandButton2_Click()
Dim C As Variant
Dim DossierEnCours As String
DossierEnCours = ThisWorkbook.Path
Workbooks.Open Filename:=DossierEnCours & "\ddpp71.xlsx"

Application.ScreenUpdating = False

For Each C In ThisWorkbook.Sheets("liste").Range("A1:A22")
ActiveWorkbook.SaveAs Filename:=DossierEnCours & "\" & C & ".xlsx"

Next

ThisWorkbook.Sheets("liste").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

voici la deuxieme mais je n e sais faire la boucle de la condition

[codeDim dossierEnCours As String

dossierEnCours = ThisWorkbook.Path

Workbooks.Open Filename:=dossierEnCours & "\ddpp72.xlsx"

Workbooks.Open Filename:=dossierEnCours & "\ddi.xlsx"

Workbooks("ddi.xlsx").Sheets("v2").Range("K3:AK33").Copy

Workbooks("DDPP72.xlsx").Sheets("collaborateurs").Range("b5:ab33").PasteSpecial Paste:=xlPasteValues][/code]

le but s est d imbriquer les 2 macros ensembles

la valeur chercher et le nom du dossier créer et cette valeur ( la condition )

cette condition se trouve se trouve dans le classeur ddi feuille v2 colonne : R

merci pour votre aide

Le 27/02/2014 à 14:28

Bonjour

Je t'ai fait une macro qui correspond à ce que tu demandais

will83177 a écrit :

dans le fichier DDI feuille V2 je souhaite copier les élément relatif Range("K3:AK??").copy mais avec une condition le nom du dossier créer ( la sa bloque )

et qui me recopie cette partie dans le classeur nouvellement créer dans la feuille collaborateurs range ( b3:ab??)

Cette plage est copiée dans chaque classeur

Maintenant tu sors une autre condition en plus du nom

will83177 a écrit :

cette condition se trouve se trouve dans le classeur ddi feuille v2 colonne : R

Je ne vais pas jouer au devinettes longtemps

Sans tes fichiers et une explication claire je passe la main

Amicalement

Le 27/02/2014 à 14:41

je ne cherche pas à faire des devinette s

je n arrive pas a mettre mon fichier en ligne

je tai envoyer un mp

merci a toi

Le 27/02/2014 à 15:13

voila le part feu de la boite me bloquait l envoie de fichier

le voici

merci pour ta patience

26commande.zip (13.35 Ko)
25ddpp71.xlsx (232.62 Ko)
26ddi.xlsx (48.60 Ko)
Le 27/02/2014 à 16:30

Bonjour

Bon j'ai les fichiers, manque plus que l'explication claire

Ce que j'ai compris

La 1ère macro crée des fichiers suivant un modèle ( DDPP71) et ces fichiers se nomment DDPP72, DDPP73, DDPP74 etc ....

Ce que je ne comprends pas c'est la 2ème macro

Tu ouvres le fichier DDPP72 (nouvellement créé) et depuis le fichier DDI tu y copies 30 lignes ( de la ligne 3 à la ligne 33 )

Pourquoi le fichier DDPP72 ?

Pourquoi 30 lignes ?

Il faut faire pareil avec les autres fichiers DDPP73, DDPP74 etc... ?

Il faut y copier toujours ces mêmes lignes ?

Réponds à ces questions

Le 27/02/2014 à 18:31

merci pour t on aide

j ai travaillé toute l après midi dessus pour fusionner les 2 macro

peut etre que mon code est pas jolie mais cela marche en partie

le voici

Private Sub CommandButton2_Click()
Dim C As Variant
Dim dossierEnCours As String
dossierEnCours = ThisWorkbook.Path
Workbooks.Open Filename:=dossierEnCours & "\ddpp71.xlsx", UpdateLinks:=False

Application.ScreenUpdating = False

For Each C In ThisWorkbook.Sheets("liste").Range("A1:A3")
ActiveWorkbook.SaveAs Filename:=dossierEnCours & "\" & C & ".xlsx"

Next

For Each C In ThisWorkbook.Sheets("liste").Range("A1:A3")

Workbooks.Open Filename:=dossierEnCours & "\" & C & ".xlsx", UpdateLinks:=False
Workbooks.Open Filename:=dossierEnCours & "\ddi.xlsx", UpdateLinks:=False

Workbooks("ddi.xlsx").Sheets("v2").Range("K3:AK33").Copy
Workbooks(C & ".xlsx").Sheets("collaborateurs").Range("b5:ab33").PasteSpecial Paste:=xlPasteValues

Next

For Each C In ThisWorkbook.Sheets("liste").Range("A1:A3")
Workbooks(C & ".xlsx").Save
Workbooks(C & ".xlsx").Close
Next

Workbooks("ddi.xlsx").Close

ThisWorkbook.Sheets("liste").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
End Sub

pour le moment j arrive a créer des classeur à partir du modele DDPP71 une fois crée

le fichier DDI s ouvre

il est copier dans chaque classeur nouvellement créer

mon problème

( espérant être clair )

la copie doit etre conditionner par le nom du fichier ( c a dire je souhaite que le fichier ddpp72 récupère les données (DDPP72) du fichier DDI feuille V2 et pour chaque dossier crée

la valeur DDPP72 se trouve dans la colonne R du fichier DDI feuille V2

je souhaite que la macro parcoure l'intégralité du fichier V2

et copie chaque ligne de K3 au ak dernière ligne correspondant au fichier en question

la collage en valeur sur de B5 AB dernier ligne fichier DDPP72 feuille collaborateur

comme tu peux le voir ma macro est capable d ouvrir créer un dossier avec un nom lui coller une partie de dossier

mais je n ai pas encore trouver

la condition

parcourir un fichier de la dernière ligne à la premier

et je pense que mon code est un peu moyen

car par exemple pour la liste je suis obligé de lui donner un range (A1 : A3 ) je préférai qu'il parcoure de lui même la colonne A et dés que s'est vide il s arrête de lui même

merci a toi

Le 27/02/2014 à 20:58

Bonsoir

A tester

42will83177-commande-v001.xlsm (26.42 Ko)
Le 27/02/2014 à 21:47

merci a toi

peux tu me conseiller un livre pour progresser

Le 27/02/2014 à 22:20

Bonsoir

Je ne te connais pas et je ne suis pas apte à juger ton niveau

Tout ce que je peux c'est de pratiquer,pratiquer, pratiquer

Les cours sur ce site sont excellents pour commencer ou pour s'améliorer

A toi de voir

Le 27/02/2014 à 22:21

merci je vais pratiquer

dessiner mes plans

un grand merci

Le 28/02/2014 à 09:55

petite question supplémentaire

If Application.Subtotal(103, WbDdi.Sheets("v2").Range("R3:R" & NbLg)) > 0 Then

pourquoi la valeur 103 car quand je la change il bug

merci pour ton aide

Le 28/02/2014 à 11:22

Bonjour

will83177 a écrit :

pourquoi la valeur 103 car quand je la change il bug

Et c'est déjà une réponse

Regardes l'aide de la fonction SOUS.TOTAL()

103 : Correspond à la fonction NBVAL() (que j'utilise si des lignes filtrées)

Rechercher des sujets similaires à "copier coller condition"