XL 2016 Macro couper coller vers onglet suivant

Zykmu · 1 Février 2022

Bonjour, Bonjour,

Pour mon club, j'essaie de faire une compta propre et plus "officielle" avec comptes comptables, bilan, compte de résultat...

On a essayé différents logiciels même sites mais jamais satisfaits...

J'en reviens sur Excel mais avec un fichier plus avancé qu'avant avec calculs, conditions, renvoi des données et cumuls pour nous faciliter la tâche...

Une chose que j'aimerais réussir à mettre au point c'est le transfert de cellules au mois suivant si la ligne n'est pas rapprochée. Donc colonne "Rapproché", "oui-non"...

Comme je n'y connais rien en macro, internet est mon ami et je tombe sur ce site sur

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [H34:H63]) Is Nothing Then 'plage à adapter
If Target.Count > 1 Then Exit Sub 'si on modifie plusieurs cellules simultanément
If UCase(Target) = "NON" Then
nouvLig = Sheets("Décembre").Cells(Rows.Count, 1).End(xlUp).Row + 1 'index de la première ligne vide dans "Archives"
Cells(Target.Row, 1).Resize(1, 13).Copy
Sheets("Décembre").Cells(nouvLig, 1).Resize(1, 13).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.EnableEvents = False 'désactiver les événements
Cells(Target.Row, 1).EntireRow.Delete
Application.EnableEvents = True
End If
End If
End Sub

Déjà, y'a un truc... ça ne colle pas sur la bonne ligne mais ça envoie bien dans l'onglet "Décembre" comme j'ai demandé...

Du coup, appel à un ami qui modifie en

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [H34:H63]) Is Nothing Then 'plage à adapter
If Target.Count > 1 Then Exit Sub 'si on modifie plusieurs cellules simultanément
If UCase(Target) = "NON" Then
nouvLig = Sheets("Décembre").Range("A" & Rows.Count).End(xlUp).Row + 1 ‘dernière ligne où la cellule A est vide de l’onglet
Cells(Target.Row, 1).Resize(1, 13).Copy
Sheets("Décembre").Cells(nouvLig, 1).Resize(1, 13).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.EnableEvents = False 'désactiver les événements
Cells(Target.Row, 1).EntireRow.Delete
Application.EnableEvents = True
End If
End If
End Sub

Là, erreur dans le script pour moi alors que lui ça fonctionne (xls2013, il a)

Je cherche donc encore de l'aide pour réussir mon fichier joint (données modifiées mais représente bien mon fichier)

Donc, l'idée étant pour chaque mois, quand je fais le rapprochement bancaire, si je met "non" dans une case "rapproché", je veux qu'il prenne le données de la ligne colonnes "A à G" pour les charges et produits ou "A à I" pour les adhésions et les collent dans le même tableau sur la première ligne dispo du mois suivant...

Etrangement quand je fais du couper-coller manuel, il me sort un "#HREF!" dans la colonne total des adhésions... et m'oblige à remplir chaque case à la main puis supprimer dans l'onglet précédent...

Vous remerciant par avance pour votre aide précieuse

++

Christophe

Zykmu · 3 Février 2022

Personne ?

Zykmu · 4 Février 2022

Zykmu · 11 Février 2022

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [H3:H16]) Is Nothing Then 'plage à adapter
If Target.Count > 1 Then Exit Sub 'si on modifie plusieurs cellules simultanément
If UCase(Target) = "NON" Then
nouvLig = Sheets("Décembre").Cells(Rows.Count, 1).End(xlUp).Row + 1 'index de la première ligne vide dans "Décembre"
Cells(Target.Row, 1).Resize(1, 8).Copy
Sheets("Décembre").Cells(nouvLig, 1).Resize(1, 8).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.EnableEvents = False 'désactiver les événements
Cells(Target.Row, 1).EntireRow.Delete
Application.EnableEvents = True
End If
End If
If Not Intersect(Target, [H19:H31]) Is Nothing Then 'plage à adapter
If Target.Count > 1 Then Exit Sub 'si on modifie plusieurs cellules simultanément
If UCase(Target) = "NON" Then
nouvLig = Sheets("Décembre").Cells(Rows.Count, 1).End(xlUp).Row + 1 'index de la première ligne vide dans "Décembre"
Cells(Target.Row, 1).Resize(1, 8).Copy
Sheets("Décembre").Cells(nouvLig, 1).Resize(1, 13).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.EnableEvents = False 'désactiver les événements
Cells(Target.Row, 1).EntireRow.Delete
Application.EnableEvents = True
End If
End If
If Not Intersect(Target, [H34:H63]) Is Nothing Then 'plage à adapter
If Target.Count > 1 Then Exit Sub 'si on modifie plusieurs cellules simultanément
If UCase(Target) = "NON" Then
nouvLig = Sheets("Décembre").Cells(Rows.Count, 1).End(xlUp).Row + 1 'index de la première ligne vide dans "Décembre"
Cells(Target.Row, 1).Resize(1, 9).Copy
Sheets("Décembre").Cells(nouvLig, 1).Resize(1, 13).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.EnableEvents = False 'désactiver les événements
Cells(Target.Row, 1).EntireRow.Delete
Application.EnableEvents = True
End If
End If
End Sub

XL 2016 Macro couper coller vers onglet suivant

Zykmu

XLDnaute Nouveau

Pièces jointes

Zykmu

XLDnaute Nouveau

Zykmu

XLDnaute Nouveau

Zykmu

XLDnaute Nouveau

Discussions similaires