Microsoft 365 Evolution macro - VBA - Copier/coller en fonction d'une ligne

[melinavy]

Bonjour à tous,

Une adorable personne m'a aidé sur ce forum pour écrire la macro suivante car je débute et au passage merci à tous pour votre aide. Aujourd'hui le besoin évolue, je m'explique :
Sur une feuille "Formulaire", j'ai des données que je vais copier sur une autre feuille "DATA". J'aimerai désormais que ça colle les cellules qui sont uniquement remplies (et donc pas les vides) pour pas que ça écrase les données déjà existante dans DATA.

Ci-dessous la macro et ci-joint une capture écran de la feuille formulaire

Merci pour votre aide et mes meilleurs vœux pour cette nouvelle année

Sub MAJ()
'Etape pour copier coller sur la bonne ligne

Sheets("Formulaire").Unprotect
If Worksheets("Formulaire").Range("M10") >= 0 Then

If MsgBox("Êtes-vous sûr de vouloir modifier la formation " & Range("A1").Value & " ?", vbQuestion + vbYesNo, "Confirmer") = vbYes Then
Sheets("Data").Unprotect
With [Data].ListObject.DataBodyRange.Rows(Me.Cells(1, 1))
.Cells(1, 23) = Range("E14")
.Cells(1, 29) = Range("E16")
.Cells(1, 27) = Range("M16")
.Cells(1, 28) = Range("M18")
.Cells(1, 24) = Range("M14")
.Cells(1, 25) = Range("Q14")
.Cells(1, 26) = Range("Q16")
.Cells(1, 31) = Range("E18")
.Cells(1, 15) = Range("E6")
.Cells(1, 18) = Range("M6")
.Cells(1, 19) = Range("E8")
.Cells(1, 12) = Range("E10")
.Cells(1, 13) = Range("I10")
.Cells(1, 16) = Range("E12")
.Cells(1, 21) = Range("E20")
.Cells(1, 30) = Range("M20")
.Cells(1, 20) = Range("I12")
.Cells(1, 14) = Range("M10")



End With
'Etape pour remettre les formules dans le formulaire après avoir écrasé lors de la modification


Range("C1").Select
Sheets("Sauvegarde").Range("C2:Q20").Copy
'cellule où copier la formule
Sheets("Formulaire").Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Formulaire").Range("Q10").Select



If MsgBox("Formation modifiée avec succès", vbInformation + vbOKOnly, "Réussite") = vbOK Then
Sheets("Data").Protect


End If
End If

Else
If MsgBox("Enregistrement impossible : Inversion date de début et fin de contrat", vbCritical + vbOKOnly, "Enregistrement impossible") = vbOK Then

End If
End If

Sheets("Formulaire").Protect
End Sub

 

[sylvanu]

Bonsoir Melinavy,

J'aimerai désormais que ça colle les cellules qui sont uniquement remplies (et donc pas les vides) pour pas que ça écrase les données déjà existante dans DATA.

Vous pourriez essayer :

If Range("E14")<>"" then .Cells(1, 23) = Range("E14")

Si E14 est vide alors on ne fait rien.

NB: Si vous pouviez utiliser les balises </> pour mettre le code, ce serait bien. Il vous suffit de cliquer sur cet icone et de coller votre code dedans. C'est infiniment plus lisible.
Et un petit fichier test représentatif permet de mieux comprendre le problème.

 

[melinavy]

Merci sylvanu pour ta réponse si rapide et précieuse. Je rajoute cette ligne pour chaque cellule collée j'imagine ?
Bien compris pour les balises je ne savais pas et je m'en excuse !

 

[sylvanu]

Bonsoir,
Oui pour toutes les lignes.

Ou plus simple en écriture en passant par un array et une boucle :

T = Array(12, "E10", 13, "I10", 14, "M10", 15, "E6", 16, "E12", 18, "M6", _
        19, "E8", 20, "I12", 21, "E20", 23, "E14", 24, "M14", 25, "Q14", _
        26, "Q16", 27, "M16", 28, "M18", 29, "E16", 30, "M20", 31, "E18")
For i = 0 To UBound(T) Step 2
    If Range(T(i + 1)) <> "" Then .Cells(1, T(i)) = Range(T(i + 1))
Next i

Dans le tableau T on a le N° colonne, puis la cellule à copier.
Ainsi pour le premier on a i=0 donc T(i)=12 T(i+1)="E10" donc ça fera :

If Range("E10") <> "" Then .Cells(1, 12) = Range("E10")

 

[melinavy]

D'accord donc je copie seulement le code du haut a la place de


<With [Data].ListObject.DataBodyRange.Rows(Me.Cells(1, 1))
.Cells(1, 23) = Range("E14")
.Cells(1, 29) = Range("E16")
.Cells(1, 27) = Range("M16")
.Cells(1, 28) = Range("M18")
.Cells(1, 24) = Range("M14")
.Cells(1, 25) = Range("Q14")
.Cells(1, 26) = Range("Q16")
.Cells(1, 31) = Range("E18")
.Cells(1, 15) = Range("E6")
.Cells(1, 18) = Range("M6")
.Cells(1, 19) = Range("E8")
.Cells(1, 12) = Range("E10")
.Cells(1, 13) = Range("I10")
.Cells(1, 16) = Range("E12")
.Cells(1, 21) = Range("E20")
.Cells(1, 30) = Range("M20")
.Cells(1, 20) = Range("I12")
.Cells(1, 14) = Range("M10")>

C'est bien ça ? Et le reste de ma macro reste inchangé ?

 

[sylvanu]

Bien compris pour les balises je ne savais pas et je m'en excuse !

Il vous faut garder cette ligne :

With [Data].ListObject.DataBodyRange.Rows(Me.Cells(1, 1))

Ca devrait donner quelque chose comme ça à tester :

Sub MAJ()
'Etape pour copier coller sur la bonne ligne
Sheets("Formulaire").Unprotect
If Worksheets("Formulaire").Range("M10") >= 0 Then
    If MsgBox("Êtes-vous sûr de vouloir modifier la formation " & Range("A1").Value & " ?", vbQuestion + vbYesNo, "Confirmer") = vbYes Then
        Sheets("Data").Unprotect
        With [Data].ListObject.DataBodyRange.Rows(Me.Cells(1, 1))
            T = Array(12, "E10", 13, "I10", 14, "M10", 15, "E6", 16, "E12", 18, "M6", _
                19, "E8", 20, "I12", 21, "E20", 23, "E14", 24, "M14", 25, "Q14", _
                26, "Q16", 27, "M16", 28, "M18", 29, "E16", 30, "M20", 31, "E18")
            For i = 0 To UBound(T) Step 2
                If Range(T(i + 1)) <> "" Then .Cells(1, T(i)) = Range(T(i + 1))
            Next i
        End With
        'Etape pour remettre les formules dans le formulaire après avoir écrasé lors de la modification
        Range("C1").Select
        Sheets("Sauvegarde").Range("C2:Q20").Copy
        'cellule où copier la formule
        Sheets("Formulaire").Range("C2").Select
        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Sheets("Formulaire").Range("Q10").Select
        If MsgBox("Formation modifiée avec succès", vbInformation + vbOKOnly, "Réussite") = vbOK Then
            Sheets("Data").Protect
        End If
    End If
Else
    If MsgBox("Enregistrement impossible : Inversion date de début et fin de contrat", vbCritical + vbOKOnly, "Enregistrement impossible") = vbOK Then
        ' Là il manque quelque chose
    End If
End If
Sheets("Formulaire").Protect
End Sub

Et prenez l'habitude d'indenter votre code, c'est beaucoup plus lisible.

 

[melinavy]

Merci ! Je teste des demain ! Excellente soirée !