XL 2016 copier/coller en VBA

Créer une discussion
Répondre

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
chinel

chinel

XLDnaute Impliqué
bonjour tout le monde, j'ai un petit soucis dans mon code VBA car quand j'encode (copier/coller) mes données de la feuille source (Encodage) vers la feuille de destination (mise en commun) si je ne remplis pas toutes les données dans ma feuille source, certaines données de ma feuille source ne se copient pas dans ma feuille de destination. Je m'explique, si je rempli B1, B2, D1, D2 et F1 de ma feuille source alors le code dois me mettre aussi les données dans la colonne N, O, P de ma feuille de destination et celui-ci ne le fais pas sauf si je remplis par exemple B1, C1 ou D1. Je ne comprends pas bien. Pouvez-vous m'aider ? Merci (voir fichier)
 

Pièces jointes

Trier par date Trier par votes
Bonjour @chinel


chinel à dit:
celui-ci ne le fais pas sauf si je remplis par exemple B1, C1 ou D1. Je ne comprends pas bien.
Cliquez pour agrandir...
Et bien c'est normal en début de macro tu fais un test pour voir si :

' Vérification si les cellules B1, D1, F1, B2 et D2 sont remplies
Cliquez pour agrandir...
Donc si toutes les cases ne sont pas remplies tu sors de la macro :
If wsSource.Range("B1").Value = "" Or wsSource.Range("D1").Value = "" Or wsSource.Range("F1").Value = "" _
Or wsSource.Range("B2").Value = "" Or wsSource.Range("D2").Value = "" Then
MsgBox "Veuillez remplir toutes les cellules en jaune, merci !", vbExclamation
Exit Sub
End If
Cliquez pour agrandir...
Donc ta macro fait exactement ce que tu lui as dit de faire.
Il faut juste modifier ta macro en fonction de tes nouvelles conditions que tu souhaites avoir .....

De plus à quoi cela te sert de mettre des commentaires dans ta macro si tu ne les lis pas !! 🙄
 
Vote positif 0 Vote négatif
Phil69970 à dit:
Bonjour @chinel



Et bien c'est normal en début de macro tu fais un test pour voir si :


Donc si toutes les cases ne sont pas remplies tu sors de la macro :

Donc ta macro fait exactement ce que tu lui as dit de faire.
Il faut juste modifier ta macro en fonction de tes nouvelles conditions que tu souhaites avoir .....

De plus à quoi cela te sert de mettre des commentaires dans ta macro si tu ne les lis pas !! 🙄
Cliquez pour agrandir...
d'accord mais si les cellules sont remplies la macro fait son travail mais à moitié
 
Vote positif 0 Vote négatif
@chinel

chinel à dit:
d'accord mais si les cellules sont remplies la macro fait son travail mais à moitié
Cliquez pour agrandir...

Tu refais une condition pour copier tes infos
' Début de la boucle pour copier les valeurs conditionnellement
Cliquez pour agrandir...

​

Tu refais une condition pour copier tes infos donc forcément si la condition n'est pas respecté la copie ne se fait pas ...

Je me répète :
Phil69970 à dit:
De plus à quoi cela te sert de mettre des commentaires dans ta macro si tu ne les lis pas !! 🙄
Cliquez pour agrandir...
Cette 2eme partie de macro ne sert à rien car elle recopie une 2eme fois les infos que tu as déjà copié !!!! 🤔

For i = 5 To 21
If Trim(wsSource.Cells(i, 2).Value) <> "" Or Trim(wsSource.Cells(i, 3).Value) <> "" Then
wsDest.Cells(destRow + 1, 7).Value = wsSource.Cells(i, 1).Value
wsDest.Cells(destRow + 1, 9).Value = wsSource.Cells(i, 2).Value
wsDest.Cells(destRow + 1, 8).Value = wsSource.Cells(i, 9).Value
wsDest.Cells(destRow + 1, 1).Value = wsSource.Range("J1").Value
wsDest.Cells(destRow + 1, 2).Value = wsSource.Range("F1").Value
wsDest.Cells(destRow + 1, 3).Value = wsSource.Range("D1").Value
wsDest.Cells(destRow + 1, 4).Value = wsSource.Range("B1").Value
wsDest.Cells(destRow + 1, 5).Value = wsSource.Range("D2").Value
wsDest.Cells(destRow + 1, 6).Value = wsSource.Range("D26").Value
wsDest.Cells(destRow + 1, 10).Value = wsSource.Range("A22").Value
wsDest.Cells(destRow + 1, 11).Value = wsSource.Range("F2").Value
wsDest.Cells(destRow + 1, 12).Value = wsSource.Range("B2").Value
wsDest.Cells(destRow + 1, 13).Value = wsSource.Range("J4").Value
wsDest.Cells(destRow + 1, 17).Value = wsSource.Range("D33").Value
Cliquez pour agrandir...
Tout ceci est inutile mais comprends tu ce que fais la macro !!!! j'en doute énormément . 🤔
 
Vote positif 0 Vote négatif
VB: 
Sub CopierVersMiseEnCommun()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim destRow As Long
    Dim missingData As Boolean
    Dim PASSWORD As String

    ' Définir les feuilles source et destination
    Set wsSource = ThisWorkbook.Sheets("Encodage")
    Set wsDest = ThisWorkbook.Sheets("Mise en commun")
    PASSWORD = "manu01" ' Mot de passe pour protéger/déprotéger

    ' Déprotéger la feuille "Mise en commun"
    wsDest.Unprotect PASSWORD:=PASSWORD

    ' Vérification si les cellules B1, D1, F1, B2 et D2 sont remplies
    If wsSource.Range("B1").Value = "" Or wsSource.Range("D1").Value = "" Or wsSource.Range("F1").Value = "" _
        Or wsSource.Range("B2").Value = "" Or wsSource.Range("D2").Value = "" Then
        MsgBox "Veuillez remplir toutes les cellules en jaune, merci !", vbExclamation
        Exit Sub
    End If

    ' Vérification des colonnes B et C
    missingData = False
    For i = 5 To 20
        If Trim(wsSource.Cells(i, 3).Value) <> "" And Trim(wsSource.Cells(i, 2).Value) = "" Then
            missingData = True
            Exit For
        End If
    Next i

    If missingData Then
        MsgBox "Veuillez remplir la durée, merci ! ", vbExclamation
        Exit Sub
    End If

    

    ' Trouver la dernière ligne non vide dans la feuille destination
    lastRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row
    destRow = lastRow + 1 ' Première ligne vide dans la feuille de destination
  

    ' Copier les valeurs fixes selon vos instructions
    wsDest.Cells(destRow, 1).Value = wsSource.Range("J1").Value
    wsDest.Cells(destRow, 2).Value = wsSource.Range("F1").Value
    wsDest.Cells(destRow, 3).Value = wsSource.Range("D1").Value
    wsDest.Cells(destRow, 4).Value = wsSource.Range("B1").Value
    wsDest.Cells(destRow, 5).Value = wsSource.Range("D2").Value
    wsDest.Cells(destRow, 6).Value = wsSource.Range("D26").Value

    wsDest.Cells(destRow, 10).Value = wsSource.Range("A22").Value
    wsDest.Cells(destRow, 11).Value = wsSource.Range("F2").Value
    wsDest.Cells(destRow, 12).Value = wsSource.Range("B2").Value
    wsDest.Cells(destRow, 13).Value = wsSource.Range("J4").Value
    wsDest.Cells(destRow, 17).Value = wsSource.Range("D33").Value
    wsDest.Cells(destRow, 8).Value = wsSource.Range("C33").Value
    wsDest.Cells(destRow, 9).Value = wsSource.Range("B5").Value
 
    
    
    ' Autres calculs
        wsDest.Cells(destRow, 15) = Year(wsDest.Cells(destRow, 1)) & "-" & WorksheetFunction.IsoWeekNum(wsDest.Cells(destRow, 1))
        wsDest.Cells(destRow, 16) = Year(wsDest.Cells(destRow, 1)) & "-" & Month(wsDest.Cells(destRow, 1))
    

    ' Début de la boucle pour copier les valeurs conditionnellement
'For i = 5 To 21
    'If Trim(wsSource.Cells(i, 2).Value) <> "" Or Trim(wsSource.Cells(i, 3).Value) <> "" Then
       ' wsDest.Cells(destRow, 7).Value = wsSource.Cells(i, 1).Value
        'wsDest.Cells(destRow, 9).Value = wsSource.Cells(i, 2).Value
       ' wsDest.Cells(destRow, 8).Value = wsSource.Cells(i, 9).Value
 
      
        

        ' Vérification avant de faire la division
        If IsNumeric(wsDest.Cells(destRow, 12).Value) And IsNumeric(wsDest.Cells(destRow, 11).Value) Then
            ' Convertir l'heure (F2) en nombre d'heures en multipliant par 24
            Dim hours As Double
            hours = wsDest.Cells(destRow, 11).Value * 24 ' Conversion de l'heure en nombre d'heures

            If hours <> 0 Then
                wsDest.Cells(destRow, 14).Value = wsDest.Cells(destRow, 12).Value / hours
            Else
                wsDest.Cells(destRow, 14).Value = "Division par zéro"
            End If
        Else
            wsDest.Cells(destRow, 14).Value = "Erreur de données"
        End If
        
        

        destRow = destRow + 1
    


    ' Nettoyer le presse-papiers
    Application.CutCopyMode = False

    ' Imprimer la plage A1:J27 de la feuille "Encodage" avant d'effacer les données
    With wsSource
        .PageSetup.PrintArea = "A1:J27" ' Définir la zone d'impression
        .PageSetup.Orientation = xlLandscape ' Orientation paysage
        .PageSetup.Zoom = False
        .PageSetup.FitToPagesWide = 1 ' Ajuster à 1 page en largeur
        .PageSetup.FitToPagesTall = 1 ' Ajuster à 1 page en hauteur

        ' Imprimer directement
        .PrintOut
    End With

   ' Déprotéger la feuille "Encodage"
wsSource.Unprotect PASSWORD:=PASSWORD


    ' Effacer toutes les données
    wsSource.Range("B1, B2, D1, F1, D2").ClearContents
    wsSource.Range("B5:H20").ClearContents
    wsSource.Range("A22").MergeArea.ClearContents


' Protéger à nouveau la feuille "Encodage" et "Mise en commun"
wsSource.Protect PASSWORD:=PASSWORD
wsDest.Protect PASSWORD:=PASSWORD

' Message de fin
MsgBox "Encodage terminé et imprimé, merci !", vbInformation

  


    ' Sauvegarder le fichier
    ThisWorkbook.Save
     'ThisWorkbook.Close
  

End Sub
 
Vote positif 0 Vote négatif
Bonjour à tous et joyeux Noël,
Voici un essai qui complète les colonnes manquantes MEME s'il n'y a pas d'incident.
Pas certain d'avoir tout compris de la logique de cette application : je me suis contenté de compléter les colonnes.
Merci de confirmer que cela résout ton souci ou d'expliquer ce que tu attends exactement de ce tableau
A bientôt
Chris
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour à tous

@chinel

chinel à dit:
j'ai trouvé le problème en cherchant un peu.
Cliquez pour agrandir...

Pour rappel tu es sur un forum et le moins que tu puisses faire c'est de donner le résultat que tu as trouvé au lieu de le garder pour toi !

Cela s'appelle le partage et cela est particulièrement valable le jour de Noël 🤔

Et comme tu dis :
chinel à dit:
je vous souhaite un très joyeux Noël !
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Phil69970 à dit:
Bonjour à tous

@chinel



Pour rappel tu es sur un forum et le moins que tu puisses faire c'est de donner le résultat que tu as trouvé au lieu de le garder pour toi !

Cela s'appelle le partage et cela est particulièrement valable le jour de Noël 🤔

Et comme tu dis :
Cliquez pour agrandir...
VB: 
Sub CopierVersMiseEnCommun()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim destRow As Long
    Dim missingData As Boolean
    Dim PASSWORD As String
    Dim valeurCol11 As Double
    Dim valeurCol12 As Double
    Dim reponse As VbMsgBoxResult

    ' Définir les feuilles source et destination
    Set wsSource = ThisWorkbook.Sheets("Encodage")
    Set wsDest = ThisWorkbook.Sheets("Mise en commun")
    PASSWORD = "manu01" ' Mot de passe pour protéger/déprotéger

    ' Déprotéger la feuille "Mise en commun"
    wsDest.Unprotect PASSWORD:=PASSWORD

    ' Vérification si les cellules B1, D1, F1, B2 et D2 sont remplies
    If wsSource.Range("B1").Value = "" Or wsSource.Range("D1").Value = "" Or wsSource.Range("F1").Value = "" _
        Or wsSource.Range("B2").Value = "" Or wsSource.Range("D2").Value = "" Then
        MsgBox "Veuillez remplir toutes les cellules en jaune, merci !", vbExclamation
        Exit Sub
    End If

    ' Vérification des colonnes B et C
    missingData = False
    For i = 5 To 20
        If Trim(wsSource.Cells(i, 3).Value) <> "" And Trim(wsSource.Cells(i, 2).Value) = "" Then
            missingData = True
            Exit For
        End If
    Next i

    If missingData Then
        MsgBox "Veuillez remplir la durée, merci ! ", vbExclamation
        Exit Sub
    End If

    ' Trouver la dernière ligne non vide dans la feuille destination
    lastRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row
    destRow = lastRow + 1 ' Première ligne vide dans la feuille de destination

    ' Copier les données fixes
    wsDest.Cells(destRow, 1).Value = wsSource.Range("J1").Value
    wsDest.Cells(destRow, 2).Value = wsSource.Range("F1").Value
    wsDest.Cells(destRow, 3).Value = wsSource.Range("D1").Value
    wsDest.Cells(destRow, 4).Value = wsSource.Range("B1").Value
    wsDest.Cells(destRow, 5).Value = wsSource.Range("D2").Value
    wsDest.Cells(destRow, 6).Value = wsSource.Range("D26").Value

    wsDest.Cells(destRow, 10).Value = wsSource.Range("A22").Value
    wsDest.Cells(destRow, 11).Value = wsSource.Range("F2").Value
    wsDest.Cells(destRow, 12).Value = wsSource.Range("B2").Value
    wsDest.Cells(destRow, 13).Value = wsSource.Range("J4").Value
    wsDest.Cells(destRow, 17).Value = wsSource.Range("D33").Value
    wsDest.Cells(destRow, 8).Value = wsSource.Range("C33").Value

    ' Calcul de la colonne 14
    If IsNumeric(wsDest.Cells(destRow, 12).Value) And IsNumeric(wsDest.Cells(destRow, 11).Value) Then
        valeurCol12 = wsDest.Cells(destRow, 12).Value ' Valeur de la colonne 12
        valeurCol11 = wsDest.Cells(destRow, 11).Value * 24 ' Conversion de l'heure en heures

        If valeurCol11 <> 0 Then
            wsDest.Cells(destRow, 14).Value = valeurCol12 / valeurCol11
        Else
            wsDest.Cells(destRow, 14).Value = "Division par zéro"
        End If
    Else
        wsDest.Cells(destRow, 14).Value = "Erreur de données"
    End If

    ' Calculs supplémentaires pour les colonnes 15 et 16
    wsDest.Cells(destRow, 15).Value = Year(wsDest.Cells(destRow, 1).Value) & "-" & WorksheetFunction.IsoWeekNum(wsDest.Cells(destRow, 1).Value)
    wsDest.Cells(destRow, 16).Value = Year(wsDest.Cells(destRow, 1).Value) & "-" & Month(wsDest.Cells(destRow, 1).Value)
' Début de la boucle pour copier les valeurs conditionnellement
For i = 5 To 20
    If Trim(wsSource.Cells(i, 2).Value) <> "" Or Trim(wsSource.Cells(i, 3).Value) <> "" Then
        ' Trouver la prochaine ligne vide dans la colonne G
        destRow = wsDest.Cells(wsDest.Rows.Count, 7).End(xlUp).Row + 1
        
        ' Copier toutes les données associées sur la même ligne
        wsDest.Cells(destRow, 1).Value = wsSource.Range("J1").Value ' Date
        wsDest.Cells(destRow, 2).Value = wsSource.Range("F1").Value ' Machine
        wsDest.Cells(destRow, 3).Value = wsSource.Range("D1").Value ' Opérateur
        wsDest.Cells(destRow, 4).Value = wsSource.Range("B1").Value ' Autre info
        wsDest.Cells(destRow, 5).Value = wsSource.Range("D2").Value ' Donnée additionnelle
        wsDest.Cells(destRow, 6).Value = wsSource.Range("D26").Value ' Autre donnée fixe

        wsDest.Cells(destRow, 7).Value = wsSource.Cells(i, 1).Value ' Colonne G (donnée variable de la boucle)
        wsDest.Cells(destRow, 9).Value = wsSource.Cells(i, 2).Value ' Colonne I (donnée variable de la boucle)

        wsDest.Cells(destRow, 10).Value = wsSource.Range("A22").Value ' Info supplémentaire
        wsDest.Cells(destRow, 11).Value = wsSource.Range("F2").Value
        wsDest.Cells(destRow, 12).Value = wsSource.Range("B2").Value
        wsDest.Cells(destRow, 13).Value = wsSource.Range("J4").Value
        wsDest.Cells(destRow, 17).Value = wsSource.Range("D33").Value
        wsDest.Cells(destRow, 8).Value = wsSource.Range("C33").Value ' Donnée additionnelle

        ' Calcul de la colonne 14
        If IsNumeric(wsDest.Cells(destRow, 12).Value) And IsNumeric(wsDest.Cells(destRow, 11).Value) Then
            valeurCol12 = wsDest.Cells(destRow, 12).Value ' Valeur de la colonne 12
            valeurCol11 = wsDest.Cells(destRow, 11).Value * 24 ' Conversion de l'heure en heures

            If valeurCol11 <> 0 Then
                wsDest.Cells(destRow, 14).Value = valeurCol12 / valeurCol11
            Else
                wsDest.Cells(destRow, 14).Value = "Division par zéro"
            End If
        Else
            wsDest.Cells(destRow, 14).Value = "Erreur de données"
        End If

        ' Calculs supplémentaires pour les colonnes 15 et 16
        wsDest.Cells(destRow, 15).Value = Year(wsDest.Cells(destRow, 1).Value) & "-" & WorksheetFunction.IsoWeekNum(wsDest.Cells(destRow, 1).Value)
        wsDest.Cells(destRow, 16).Value = Year(wsDest.Cells(destRow, 1).Value) & "-" & Month(wsDest.Cells(destRow, 1).Value)
    End If
Next i

 


    ' Nettoyer le presse-papiers
    Application.CutCopyMode = False

    ' Imprimer la plage A1:J27 de la feuille "Encodage" avant d'effacer les données
    With wsSource
        .PageSetup.PrintArea = "A1:J27" ' Définir la zone d'impression
        .PageSetup.Orientation = xlLandscape ' Orientation paysage
        .PageSetup.Zoom = False
        .PageSetup.FitToPagesWide = 1 ' Ajuster à 1 page en largeur
        .PageSetup.FitToPagesTall = 1 ' Ajuster à 1 page en hauteur

        ' Imprimer directement
        .PrintOut
    End With
    
   ' Afficher une boîte de dialogue pour demander à l'utilisateur s'il a fini
    reponse = MsgBox("Avez-vous terminé ?", vbQuestion + vbYesNo, "Confirmation")

    ' Vérifie la réponse
    If reponse = vbYes Then
        ' Effacer toutes les données
        wsSource.Range("B1, B2, D1, F1, D2").ClearContents
        wsSource.Range("B5:H20").ClearContents
        wsSource.Range("A22").MergeArea.ClearContents
        MsgBox "Ok", vbInformation, "Encodage terminé et imprimé, merci !"
         wsSource.Protect PASSWORD:=PASSWORD
    wsDest.Protect PASSWORD:=PASSWORD
ThisWorkbook.Save
ThisWorkbook.Close
        
    Else
        ' Effacer toutes les données sauf B1 et D1
        wsSource.Range("B2, F1, D2").ClearContents
        wsSource.Range("B5:H20").ClearContents
        wsSource.Range("A22").MergeArea.ClearContents
        MsgBox "Ok.", vbInformation, "Encodage terminé et imprimé, merci !"
    End If

    ' Protéger à nouveau les feuilles
    wsSource.Protect PASSWORD:=PASSWORD
    wsDest.Protect PASSWORD:=PASSWORD

    

    ' Sauvegarder le fichier
    ThisWorkbook.Save

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

A
  • Question Question
Déplacer données en vba
Réponses
3
Affichages
469
akm
A
A
  • Résolu(e)
XL 2021 Création de tableau
2
Réponses
29
Affichages
479
Alamyr
A
P
  • Question Question
XL 2016 VBA Appliquer un filtre sur mes données importées
Réponses
4
Affichages
492
sousou
sousou
P
  • Question Question
XL 2019 Macro VBA appliquer un filtre lors d'une importation de données
Réponses
1
Affichages
373
fanch55
fanch55
A
  • Question Question
Microsoft 365 Macro pour récupérer des colonnes qui ne sont pas conjointes
Réponses
4
Affichages
414
Anthony_51
A
flc13090
  • Résolu(e)
XL 2019 Problème de copie de plages non contiguës vers une autre feuille en VBA
Réponses
9
Affichages
288
flc13090
flc13090
treza88
  • Question Question
XL 2021 Copier coller qui ajoute une référence absolu Toute seule
2
Réponses
24
Affichages
894
TooFatBoy
TooFatBoy
D
  • Question Question
XL 2019 Application.run
Réponses
4
Affichages
369
dadaze
D
N
  • Question Question
Microsoft 365 appliquer la formule en changeant de ligne et de colonne
Réponses
2
Affichages
164
ndranghettino
N
VBA_dev_Anne_Marie
  • Résolu(e)
Microsoft 365 VBA : copier 2 onglets
Réponses
4
Affichages
164
job75
job75
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
329
Pierreavecunp
P
Jiheme
  • Question Question
XL 2019 Macro bloque en court de travail
Réponses
4
Affichages
254
fanch55
fanch55
X
  • Question Question
XL 2021 Génération word à partir d'excel en gardant le format source
Réponses
8
Affichages
234
xlym
X
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
394
xavieralvaro
X
M
  • Résolu(e)
XL 2021 Copier/Coller des valeurs d’une feuille à une autre à partir d’une cellule
Réponses
11
Affichages
451
MANU64360
M
yaka
  • Question Question
Microsoft 365 faire une copie d'un fichier stocké dans un sous sous... sous répertoire
2
Réponses
20
Affichages
597
TooFatBoy
TooFatBoy
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
2 K
job75
job75
P
  • Question Question
Microsoft 365 VBA copier-coller selon conditions
Réponses
4
Affichages
231
vgendron
vgendron
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
369
CDALE
C
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
914
Dranreb
Dranreb
Retour