Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

M

melinavy

XLDnaute Nouveau
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
 

Pièces jointes

  • Capture formulaire.JPG
    111.6 KB · Affichages: 36
Trier par date Trier par votes

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Melinavy,
melinavy à dit:
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.
Cliquez pour agrandir...
Vous pourriez essayer :
VB: 
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.
 
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir,
Oui pour toutes les lignes.

Ou plus simple en écriture en passant par un array et une boucle :
VB: 
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 :
Code: 
If Range("E10") <> "" Then .Cells(1, 12) = Range("E10")
 
Vote positif 0 Vote négatif
M

melinavy

XLDnaute Nouveau
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é ?
 
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
melinavy à dit:
Bien compris pour les balises je ne savais pas et je m'en excuse !
Cliquez pour agrandir...


Il vous faut garder cette ligne :
VB: 
With [Data].ListObject.DataBodyRange.Rows(Me.Cells(1, 1))

Ca devrait donner quelque chose comme ça à tester :
Code: 
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.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
157
sebastien176
S
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
991
job75
  • Question
Microsoft 365 Trier des données et les afficher sur une autre feuille
Réponses
10
Affichages
366
Jojo973
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
593
laurent950
S
  • Résolu(e)
XL 2016 Comment faire ressortir la ligne sélectionnée dans un tableau
Réponses
2
Affichages
432
Stéphane_1
S
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
376
job75
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
349
Gégé-45550
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
598
dadu35
D
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…