Condition pour copier

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Turbo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
T

Turbo

XLDnaute Junior
Alors voila, je refais appel a vos talents de VBAiste pour m'aider a résoudre un problème....

Explication de ma macro :

La macro çi dessous permet d'enregistrer des valeurs qui sont sur la feuille source ( qui est propre aux utilisateurs, et qui possède le bouton pour activer ma macro ) vers une autre feuilles excel.
Selon les initiales rentrées dans la feuille source, la macro permettra d'enregistrer les données de la feuille source, dans différentes colonnes de la feuille de destination.

Code: 
Private Sub Enregistrer_Click()
        
    Dim myRange As Range
    Workbooks("Formulaire heures modif 08.xls").Activate
    With Sheets("Mensuel")
    .Range("AK7:AK81").Copy
    If Val(Cells(3, 25).Value) = "MLB" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("B7:B81")
    ElseIf Val(Cells(3, 25).Value) = "IB" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("C7:C81")
    ElseIf Val(Cells(3, 25).Value) = "MHR" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("D7:D81")
    ElseIf Val(Cells(3, 25).Value) = "FF" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("E7:E81")
    ElseIf Val(Cells(3, 25).Value) = "Gry" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("F7:F81")
    ElseIf Val(Cells(3, 25).Value) = "CR" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("H7:H81")
    ElseIf Val(Cells(3, 25).Value) = "GB" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("I7:I81")
    ElseIf Val(Cells(3, 25).Value) = "OA" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("K7:K81")
    ElseIf Val(Cells(3, 25).Value) = "HD" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("L7:L81")
    ElseIf Val(Cells(3, 25).Value) = "PM" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("M7:M81")
    ElseIf Val(Cells(3, 25).Value) = "SG" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("N7:N81")
    ElseIf Val(Cells(3, 25).Value) = "KI" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("O7:O81")
    ElseIf Val(Cells(3, 25).Value) = "CM" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("P7:P81")
    ElseIf Val(Cells(3, 25).Value) = "AR" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("Q7:Q81")
    ElseIf Val(Cells(3, 25).Value) = "FE" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("R7:R81")
    ElseIf Val(Cells(3, 25).Value) = "PF" Then
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        With Sheets("DEC")
        Set myRange = Worksheets("DEC").Range("S7:S81")
    Else
        MsgBox ("Erreur dans le nom")
    End If
    End With
    myRange.Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    End With
            
End Sub

Je n'arrive pas a corriger le code pour qu'il fonctionne ( et qu'il fasse ce dont je demande accessoirement ) ...

Merci de prendre de votre temps a essayer de m'aider 😉

Je vous joins avec, les 2 fichiers excels :

Edit : Il faut que les deux fichiers excel soient ouvert !!
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Re : Condition pour copier

Bonjour Turbo, bonjour le forum,

Elle est sur quel Classeur / Onglet la cellule Cells(3, 25) ?
Peut-être manque-t-il juste un point devant : If Val(.Cells(3, 25).Value) si c'est une cellule de l'onglet Mensuel du classeur Formulaire heures modif 08.xls.
 
Vote positif 0 Vote négatif
Re : Condition pour copier

Salut,

Elle n'a pas finit de planter ta macro.

Tu ouvres des "With" sans jamais les refermer.
Pour information, les "With" sont là pour faciliter la lecture de nous, pauvres humains.

With Selection
.value=15
End With

Reviens à écrire
Selection.value=15

Mais permet en cas d'action multiple de ne pas réécrire "Selection"

Les "With" peuvent être imbriqués mais doivent être refermé avant toutes instructions de structure non imbriquées.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Condition pour copier

Bonjour Turbo, bonjour le forum,

Essaie comme ça :
Code: 
Private Sub Enregistrer_Click()
 
Dim myRange As Range
Dim s As Worksheet 'déclare la variable s
Set s = Sheets("DEC") 'définit la variasble s
Workbooks("Formulaire heures modif 08.xls").Activate
Sheets("Mensuel").Range("AK7:AK81").Copy
 
Select Case Val(Sheets("Mensuel").Cells(3, 25).Value)
 
    Case "MLB"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("B7:B81")
    Case "IB"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("C7:C81")
    Case "MHR"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("D7:D81")
    Case "FF"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("E7:E81")
    Case "Gry"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("F7:F81")
    Case "CR"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("H7:H81")
    Case "GB"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("I7:I81")
    Case "OA"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("K7:K81")
    Case "HD"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("L7:L81")
    Case "PM"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("M7:M81")
    Case "SG"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("N7:N81")
    Case "KI"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("O7:O81")
    Case "CM"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("P7:P81")
    Case "AR"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("Q7:Q81")
    Case "FE"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("R7:R81")
    Case "PF"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("S7:S81")
    Case Else
        MsgBox ("Erreur dans le nom")
End Select
 
myRange.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
 
End Sub
 
Vote positif 0 Vote négatif
Re : Condition pour copier

Bonjour Turbo, bonjour le forum,

J'ai pris le temps de tester en ouvrant les fichiers et j'ai modifié pour que ça fonctionne. Ça donne :

Code: 
Private Sub Enregistrer_Click()
 
Dim myRange As Range
Dim s As Worksheet 'déclare la variable s
Set s = Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Sheets("DEC")  'définit la variasble s
Workbooks("Formulaire heures modif 08.xls").Activate
Sheets("Mensuel").Range("AK7:AK81").Copy
 
Select Case Sheets("Mensuel").Cells(3, 25).Value
 
    Case "MLB"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("B7:B81")
    Case "IB"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("C7:C81")
    Case "MHR"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("D7:D81")
    Case "FF"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("E7:E81")
    Case "Gry"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("F7:F81")
    Case "CR"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("H7:H81")
    Case "GB"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("I7:I81")
    Case "OA"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("K7:K81")
    Case "HD"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("L7:L81")
    Case "PM"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("M7:M81")
    Case "SG"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("N7:N81")
    Case "KI"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("O7:O81")
    Case "CM"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("P7:P81")
    Case "AR"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("Q7:Q81")
    Case "FE"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("R7:R81")
    Case "PF"
        Workbooks("Synthése Aôut, Sept Modif2 07BIS.xls").Activate
        Set myRange = s.Range("S7:S81")
    Case Else
        MsgBox ("Erreur dans le nom")
End Select
 
myRange.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
 
End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
394
TooFatBoy
TooFatBoy
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
181
patricktoulon
patricktoulon
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
644
CortoXls
C
S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
633
spike29
S
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
427
thunder23
thunder23
C
  • Résolu(e)
Autres Copier des données vers une nouvelle feuille excel VBA
2
Réponses
25
Affichages
995
Carolinebd
C
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
438
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
364
Latias
L
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
748
Dranreb
Dranreb
D
  • Résolu(e)
XL 2019 Nouveau Numéro
2 3 4
Réponses
57
Affichages
2 K
patricktoulon
patricktoulon
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
348
KRUG WOO
K
F
  • Résolu(e)
Autres Insérer une ligne
2 3
Réponses
36
Affichages
2 K
francescofrancesco
F
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
224
CDALE
C
J
  • Question Question
XL 2021 transfert listview vers feuille excel
Réponses
9
Affichages
417
Piment
P
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
M
  • Question Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
993
Mody200
M
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
427
patricktoulon
patricktoulon
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
698
telemarrk
T
E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
268
escudo
E
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
743
M@xu3L
M
Retour