supprimer les données d'un tableau et les envoyées vers un autre

wooddy

XLDnaute Nouveau
Bonjour
j'ai une missions qui consiste a faire des tableaux de bord pour encaissement de chèques,
je souhaite extraire les chèque qui ont pour échéance la date d'aujourd'hui et les supprimer du premier tableau pour les inserer dans un autre
j'ai mis les tableau en PJ la feuil 1 contient le tableau sur lequel je veux travailler la macro que j'avais n’exécute plus la selection
merci beucoup
cordialement
 

Pièces jointes

  • recap tableau de bord.xls
    183.5 KB · Affichages: 470
  • recap tableau de bord.xls
    183.5 KB · Affichages: 509
  • recap tableau de bord.xls
    183.5 KB · Affichages: 510
G

Guest

Guest
Re : supprimer les données d'un tableau et les envoyées vers un autre

Bonjour,

Ta macro fonctionne bien si tu lui donne le nom exacte des feuilles concernées.
Il t'es necessaire d'apprendre les bases de travaille sur les feuilles. Attention,tu as un espace dans le nom de la feuille 2 : "echeancier " -> source d'erreur

Les lignes d'origine sont supprimées.

Si tu utilises dl = .Range("B65536").End(xlUp).Row

Il serait préférable que tu déplaces ton second tableau (qu'il n'y ait rien de B65536 à la dernière ligne de la liste des chèques.) ou alors choisir une autre méthode.


Code:
Sub Macro1()
Dim dl As Long
Dim cel As Range
Dim dest As Range
Dim RangeToDelete As Range
 
'Application.ScreenUpdating = False
With Sheets("echeancier ")
    dl = .Range("B65535").End(xlUp).Row + 1
    .Rows("3:" & dl).ClearContents
End With
With Sheets("chèques en portefeuille")
    dl = .Range("B65536").End(xlUp).Row
    For Each cel In .Range("H3:H" & dl)
        If cel.Value = Date Then
            Set dest = Sheets("echeancier ").Range("B65536").End(xlUp).Offset(1, 0)
            With .Range(Cells(cel.Row, 2), Cells(cel.Row, 11))
                .Copy dest
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells)
                End If
            End With
        End If
    Next cel
End With
If Not RangeToDelete Is Nothing Then RangeToDelete.Delete
Sheets("echeancier ").Select
Range("A1").Select
'Application.ScreenUpdating = True
End Sub

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 775
Messages
2 092 023
Membres
105 151
dernier inscrit
Stephkno