XL 2019 macro couper-coller sur plusieurs onglets

[rh.finances]

Bonsoir à tou(te)s,

utilisateur peu aguerri sur VBA, je rencontre une difficulté pour finaliser un code en vue de couper - coller des données sur plusieurs onglets.
Les onglets en question correspondent aux 12 mois de l'année, à savoir : janv. / févr. / mars / avr. / mai / juin / juil. / août / sept. / oct. / nov. / déc.

je dispose d'un code qui fonctionne très bien pour un seul mois (voir ci-dessous pour le mois de janv)

Sub Macro1()
 ActiveSheet.Unprotect ""
 Dim lig As Integer
 Dim lig2 As Integer
 With ActiveSheet
 For lig = .Range("H65536").End(xlUp).Row To 2 Step -1
     lig2 = Sheets("janv.").Range("H65536").End(xlUp).Row
     If .Range("H" & lig).Value = "janv." Then
         .Rows(lig).Cut Sheets("janv.").Rows(lig2 + 1)
         .Rows(lig).Delete Shift:=xlUp
     End If
 Next
 End With
 ActiveSheet.Protect ""
 End Sub

comme vous pourrez le constater sur le fichier joint, j'ai créé 12 macros du même type pour chaque mois de l'année dans l'onglet "détail dépenses / recettes".

Toutefois, mon souhait serait de regrouper ces 12 macros en une seule, ce qui me permettrait de couper - coller les données de l'onglet "détail dépenses / recettes" sur les onglets de chaque mois de l'année, en cliquant sur l'image "intégration" présente sur l'onglet "détail dépenses / recettes"

Vous remerciant par avance de vos contributions.
bonne soirée

Alex

 

[Gégé-45550]

Bonsoir à tou(te)s,

utilisateur peu aguerri sur VBA, je rencontre une difficulté pour finaliser un code en vue de couper - coller des données sur plusieurs onglets.
Les onglets en question correspondent aux 12 mois de l'année, à savoir : janv. / févr. / mars / avr. / mai / juin / juil. / août / sept. / oct. / nov. / déc.

je dispose d'un code qui fonctionne très bien pour un seul mois (voir ci-dessous pour le mois de janv)

Sub Macro1()
 ActiveSheet.Unprotect ""
 Dim lig As Integer
 Dim lig2 As Integer
 With ActiveSheet
 For lig = .Range("H65536").End(xlUp).Row To 2 Step -1
     lig2 = Sheets("janv.").Range("H65536").End(xlUp).Row
     If .Range("H" & lig).Value = "janv." Then
         .Rows(lig).Cut Sheets("janv.").Rows(lig2 + 1)
         .Rows(lig).Delete Shift:=xlUp
     End If
 Next
 End With
 ActiveSheet.Protect ""
 End Sub

comme vous pourrez le constater sur le fichier joint, j'ai créé 12 macros du même type pour chaque mois de l'année dans l'onglet "détail dépenses / recettes".

Toutefois, mon souhait serait de regrouper ces 12 macros en une seule, ce qui me permettrait de couper - coller les données de l'onglet "détail dépenses / recettes" sur les onglets de chaque mois de l'année, en cliquant sur l'image "intégration" présente sur l'onglet "détail dépenses / recettes"

Vous remerciant par avance de vos contributions.
bonne soirée

Alex

Bonsoir,
Une proposition que je n'ai pas testée car je n'ai pas ouvert votre fichier mais qui devrait marcher.

Sub Macro1()
 ActiveSheet.Unprotect ""
 Dim lig As Integer
 Dim lig2 As Integer
 Dim NomFeuille$
 With ActiveSheet
 For lig = .Range("H65536").End(xlUp).Row To 2 Step -1
     NomFeuille = .Range("H" & lig).Value
     lig2 = Sheets(NomFeuille).Range("H65536").End(xlUp).Row
     .Rows(lig).Cut Sheets(NomFeuille).Rows(lig2 + 1)
     .Rows(lig).Delete Shift:=xlUp
 Next
 End With
 ActiveSheet.Protect ""
 End Sub

Cordialement,

 

[Phil69970]

Bonjour à tous

@rh.finances

Je te propose ce fichier

Merci de ton retour

 

[rh.finances]

Bonjour Gégé, Bonjour Phil,

Je viens de tester vos solutions.
Gégé, j'ai un message d'erreur m'indiquant que "l'indice n'appartient pas à la sélection"
Phil, la macro marche au top et en plus, j'ai un petit message d'info très utile.

Milles mercis pour votre aide et votre réactivité. C'était vraiment sympa de votre part

Bonne journée.

Alex

 

[Gégé-45550]

Bonjour Gégé, Bonjour Phil,

Je viens de tester vos solutions.
Gégé, j'ai un message d'erreur m'indiquant que "l'indice n'appartient pas à la sélection"
Phil, la macro marche au top et en plus, j'ai un petit message d'info très utile.

Milles mercis pour votre aide et votre réactivité. C'était vraiment sympa de votre part

Bonne journée.

Alex

Bonjour rh.finances,
Pour info et après avoir enfin ouvert votre fichier pour vérification, le code que que je vous ai fourni au post #2, basé sur le vôtre, marche parfaitement à la double condition que :

1. lorsqu'une ligne de compte est remplie, il existe une valeur correcte dans la colonne H de la même ligne (la cellule H3 de votre fichier est vide)
2. la dernière cellule de la colonne H corresponde à la dernière ligne d'écriture (idem pour les onglets des mois). Dans votre fichier, chacun de ces onglets contiennent en H92 la formule "=SOUS.TOTAL(9;H2:H90)", ce qui a pour effet de fausser le calcul des variables lig et lig2 (elles valent forcément 92 au départ de la macro) et donc d'aboutir au fameux message "l'indice n'appartient pas à la sélection".

Inscrivez la formule "=SOUS.TOTAL(9;H2:H90)" par exemple en G92 dans chacun des onglets et vous vérifierez que la macro fonctionne correctement.
Cordialement,

 

[rh.finances]

Bonjour rh.finances,
Pour info et après avoir enfin ouvert votre fichier pour vérification, le code que que je vous ai fourni au post #2, basé sur le vôtre, marche parfaitement à la double condition que :

1. lorsqu'une ligne de compte est remplie, il existe une valeur correcte dans la colonne H de la même ligne (la cellule H3 de votre fichier est vide)
2. la dernière cellule de la colonne H corresponde à la dernière ligne d'écriture (idem pour les onglets des mois). Dans votre fichier, chacun de ces onglets contiennent en H92 la formule "=SOUS.TOTAL(9;H2:H90)", ce qui a pour effet de fausser le calcul des variables lig et lig2 (elles valent forcément 92 au départ de la macro) et donc d'aboutir au fameux message "l'indice n'appartient pas à la sélection".

Inscrivez la formule "=SOUS.TOTAL(9;H2:H90)" par exemple en G92 dans chacun des onglets et vous vérifierez que la macro fonctionne correctement.
Cordialement,

Bonjour Gégé et merci pour ce retour complémentaire.
J'ai fait le test : la macro s'exécute sans erreur mais aucune donnée ne se colle dans les onglets dédiés. A toutes fins utiles, j'ai joint le fichier actualisé à ce message.
Encore merci pour tout

 

[Gégé-45550]

Bonjour Gégé et merci pour ce retour complémentaire.
J'ai fait le test : la macro s'exécute sans erreur mais aucune donnée ne se colle dans les onglets dédiés. A toutes fins utiles, j'ai joint le fichier actualisé à ce message.
Encore merci pour tout

Bonjour,
les données sont bien collées, mais sous la ligne 92.
C'est parce que vous n'avez pas lu jusqu'au bout mon message précédent et que vous avez laissé des formules dans le cellules H92 des onglets dédiés.
Essayez le fichier joint, où j'ai déplacé les formules des H92 en G92 et vous verrez.
Cordialement,

 

[rh.finances]

Bonjour,
les données sont bien collées, mais sous la ligne 92.
C'est parce que vous n'avez pas lu jusqu'au bout mon message précédent et que vous avez laissé des formules dans le cellules H92 des onglets dédiés.
Essayez le fichier joint, où j'ai déplacé les formules des H92 en G92 et vous verrez.
Cordialement,

Au temps pour moi Gégé. je viens de voir en effet mon erreur et je vous confirme que la macro fonctionne parfaitement. Encore merci pour tout !!

 

[job75]

Bonsoir,

En utilisant des tableaux structurés :

Sub Transfert()
Dim col%, P As Range, T As Range, w As Worksheet
col = 8 'colonne à filtrer
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
With Sheets("détail dépenses - recettes").ListObjects(1)
    Set P = .Range
    Set T = .DataBodyRange
    .ShowTotals = False 'masque la ligne du total
    For Each w In Worksheets
        If IsDate("1/" & w.Name) Then
            w.ListObjects(1).DataBodyRange.Delete xlUp 'RAZ
            P.AutoFilter col, w.Name 'filtre automatique
            w.ListObjects(1).ShowTotals = False 'masque la ligne du total
            T.SpecialCells(xlCellTypeVisible).Copy w.ListObjects(1).Range(2, 1) 'copier-coller
            w.ListObjects(1).ShowTotals = True 'affiche la ligne du total
            T.SpecialCells(xlCellTypeVisible) = "#N/A" 'repérage
            P.AutoFilter col 'affiche tout
        End If
    Next
    P.SpecialCells(xlCellTypeConstants, 16).Delete xlUp
    .ShowTotals = True 'affiche la ligne du total
End With
End Sub

Les tableaux de destination sont préalablement vidés.

Je ne protège pas les feuilles, c'est inutile.

Bonne nuit.

 

[job75]

Bonjour le forum,

La macro précédente vide préalablement les tableaux des mois.

Celle-ci transfère les données à la suite des données existantes :

Sub Transfert()
Dim col%, P As Range, T As Range, w As Worksheet, lig&
col = 8 'colonne à filtrer
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
With Sheets("détail dépenses - recettes").ListObjects(1)
    Set P = .Range
    Set T = .DataBodyRange
    .ShowTotals = False 'masque la ligne du total
    For Each w In Worksheets
        If IsDate("1/" & w.Name) Then
            P.AutoFilter col, w.Name 'filtre automatique
            With w.ListObjects(1)
                .ShowTotals = False 'masque la ligne du total
                lig = IIf(.Range(2, col) = "", 2, .Range.Rows.Count + 1)
                T.SpecialCells(xlCellTypeVisible).Copy .Range(lig, 1) 'copier-coller*
                .ShowTotals = True 'affiche la ligne du total
            End With
            T.SpecialCells(xlCellTypeVisible) = "#N/A" 'repérage
            P.AutoFilter col 'affiche tout
        End If
    Next
    P.SpecialCells(xlCellTypeConstants, 16).Delete xlUp
    .ShowTotals = True 'affiche la ligne du total
End With
End Sub

A+