XL 2016 copier/coller en VBA

[chinel]

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)

 

[Phil69970]

Bonjour @chinel

celui-ci ne le fais pas sauf si je remplis par exemple B1, C1 ou D1. Je ne comprends pas bien.

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

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

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

 

[chinel]

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

d'accord mais si les cellules sont remplies la macro fait son travail mais à moitié

 

[sousou]

Bonjour
Pas tout compris mais à la vue de ton code il faut aussi des valeurs dans les lignes 5 6 ....
et du parle de c1, pas sur que tu ne trompes pas
Plus de précisions seraient utile

 

[Phil69970]

@chinel

d'accord mais si les cellules sont remplies la macro fait son travail mais à moitié

Tu refais une condition pour copier tes infos

' Début de la boucle pour copier les valeurs conditionnellement

​

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 :

De plus à quoi cela te sert de mettre des commentaires dans ta macro si tu ne les lis pas !!

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

Tout ceci est inutile mais comprends tu ce que fais la macro !!!! j'en doute énormément .

 

[chinel]

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

 

[chinel]

j'ai fait ceci mais j'ai un soucis avec la colonne G de ma feuille de destination donc j'ai toujours besoin d'aide, merci. (je débute en VBA)

 

[Phil69970]

@chinel

j'ai fait ceci mais j'ai un soucis avec la colonne G de ma feuille de destination donc j'ai toujours besoin d'aide

Encore faut il savoir ce que tu veux faire et ce que doit faire TOUTE ta macro