Macro couper-coller données filtrées - Problème si filtre non applicable

[Darkvador]

Bonjour,

Je tâtonne un peu en macros, mais en principe en faisant quelques recherches j'arrive toujours à retomber sur mes pattes. Cette fois je sèche un peu, donc je viens solliciter de l'aide sur ce forum

Soit un tableau excel avec un onglet comprenant les dossiers en cours (nommé "suivi ancillary services"), et un second onglet comprenant les dossiers archivés (nommé "suivi de l'historique"). Dans l'onglet dossier en cours, une colonne D "statut" avec possibilité pour chaque ligne de choisir via menu déroulant un statut entre "Open" et "Closed". La macro fait un filtre sur les dossiers "closed" puis fait un couper-coller de la sélection vers l'onglet "dossiers archivés".

La macro fonctionne très bien tant qu'il y a effectivement des lignes en statut "closed". Par contre, là où cela cloche, c'est quand je tente d'actionner la macro alors qu'il n'y a que des lignes en statut "open". Dans ce cas, l'idéal serait que la macro s'arrête ou, au pire, tombe en erreur. Malheureusement elle s'exécute de bout en bout, bien que le filtre sur "closed" ne soit pas applicable, ce qui a pour résultat de couper-coller... la ligne d'en-tête !

J'ai beau chercher, je ne trouve pas comment empêcher cela. Si quelqu'un pouvait m'aider, cela me retirerait une belle épine du pied...

Ci-dessous mon code. Malheureusement la sécurité de mon entreprise ne permet pas l'upload du fichier en lui-même.

Sub Historisation()
'
' Historisation Macro

'
If MsgBox("Souhaitez-vous archiver les lignes sélectionnées ?", vbQuestion + vbYesNo, "CONFIRMATION") = vbYes Then
Selection.AutoFilter Field:=4, Criteria1:="Closed"
Range("A2:J2", [A65536].End(xlUp).Address).SpecialCells(xlCellTypeVisible).Cut
Sheets("Suivi de l'historique").Select
Range("a65535").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Sheets("Suivi Ancillary Services").Select
Selection.AutoFilter Field:=4
Range("A2:J1000").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Else
MsgBox ("Action annulée")
End If

End Sub

Merci par avance à tous et bonne journée

 

[Matheop]

Re : Macro couper-coller données filtrées - Problème si filtre non applicable

Salut Darkvador,

Sub ligneClosedExistante()
  Sheets("suivi ancillary services").Activate
  Set c = Range("D2:D65536").Find("closed", LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then Historisation
End Sub

Avec ça ça devrait passer. Cette macro effectue une recherche dans la colonne D de ton onglet des dossiers en cours. Si elle trouve une occurrence du mot 'closed' alors elle appelle ta macro Historisation sinon rien ne se passe.

Cordialement,
Mat'

 

[Darkvador]

Re : Macro couper-coller données filtrées - Problème si filtre non applicable

Bonjour MatiChoux,

Cela fonctionne nickel, je te remercie infiniment pour ton aide précieuse !

Bonne journée à toi.

 

[Matheop]

Re : Macro couper-coller données filtrées - Problème si filtre non applicable

De rien, ravi d'avoir pu t'aider. Bonne journée également !