Copier un tableau sans lignes vides et coller sur autre feuille à la suite [Macro]

steph34

XLDnaute Junior
Bonsoir au forum

Malgré les nombreux post qui traitent de ce sujet je n'arrive pas à adapter ce que j'ai vu à mon besoin.
C'est vrai que je ne comprends pas grand chose au VBA.

Donc voici mon besoin;

Jai un classeur excel qui représente 1 mois.
j'ai créé une feuille par jour nommée 1 jusqu'à 31.
Dans chaque feuilles se trouve plusieurs tableaux et J'aimerai récupérer les données d'un de ces tableaux par jour afin de faire un récap de fin de mois.
Il faudrai supprimer les lignes vides avant de le coller et coller les données de chaques feuilles à la suites les unes des autres.
Je vous joint un exemple du fichier.

Un grand merci de votre aide
 

Pièces jointes

  • Caisse_Test.zip
    93 KB · Affichages: 97

Grand Chaman Excel

XLDnaute Impliqué
Re : Copier un tableau sans lignes vides et coller sur autre feuille à la suite [Macr

Bonsoir steph34,

Voir les macros dans le fichier joint. (module 2)
La 1re macro permet de faire un recap de toutes les feuilles en 1 seule opérations (donc à faire seulement à la fin du mois).
La 2e macro copie les données dans la feuille Recap, une feuille à la fois. (donc à faire à chaque jour).

Reste juste à associer ta macro à un bouton ou encore de lui associer un raccourci clavier...

A+
 

Pièces jointes

  • Caisse_Test.xls
    346.5 KB · Affichages: 304

steph34

XLDnaute Junior
Re : Copier un tableau sans lignes vides et coller sur autre feuille à la suite [Macr

RE Grand Chaman

Une petite question.
Le code ci-joint que tu m'a envoyé fonctionne sauf qu'il ne me prend pas la ligne 122.
Or si je regarde elle est bien spécifié dans le code.
Si on modifie et que l'on met "123" alors il prend bien jusqu'à 122.

Aurai-tu l'explication ?

Encore merci de ta patience.

Code:
'Recap de la feuille sélectionnée
Sub Recap1Feuille()
    Dim wsRecap As Worksheet
    Dim ws As Worksheet
    Dim rg As Range, rgRecap As Range
    Dim i As Byte
    
    Application.ScreenUpdating = False
    
    Set wsRecap = Sheets("P.Différés")
    

    Set ws = ActiveSheet
    If ws.Name <> wsRecap.Name Then     '...sauf la feuille recap
        Set rg = ws.Range("T3")         'cellule de départ
        Do Until rg.Row = 122           'dernière ligne
            If rg.Text <> "" Then       'ligne non vide
                Set rgRecap = wsRecap.Range("A60000").End(xlUp).Offset(1, 0)    'ligne d'écriture
                rgRecap = ws.Range("D1")    'jour
                rg.Resize(1, 6).Copy        'données à copier
                rgRecap.Offset(0, 1).PasteSpecial xlPasteValues 'valeurs seulement
            End If
            Set rg = rg.Offset(1, 0)    'prochaine ligne
        Loop
    End If

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    End Sub
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
626

Statistiques des forums

Discussions
311 726
Messages
2 081 955
Membres
101 852
dernier inscrit
dthi16088