Copie ligne avec un TEXTE & problème d'exécution sur le classeur entier

[ssassam]

Bonjour,

Je souhaite copier tout les lignes qui contiennes le mot "TOTAL" dans une feuil appelé RECAP , j'ai créer une macro a l'aide d'une recherche sur internet , mais j'ai eu deux anomalies :

Anomalie N°1:

- la macro ne s'applique pas a toute les feuils a la fois je doit l’exécuté sur chaque feuil séparément.

Anomalie N°2:

-Vue que la ligne que je copie comprend une formule , la macro ne la converti pas en valeur ce qui me donne une ligne avec des #N/A#

Voici mon CODE ( Il est déjà inclus au fichier test "ssassam")

    Sub TEST()
    For Each cel In Range("A1:A" & Range("A65536").End(xlUp).Row)
    If UCase(cel) = "TOTAL TTC" Then
    Range("A" & cel.Row & ":F" & cel.Row).Copy _
    Sheets("RECAP").Range("A" & Sheets("RECAP").Range("A65536").End(xlUp).Row + 1)
    Sheets("RECAP").Range("A:F").EntireColumn.AutoFit
    End If
         
    Next
        
    End Sub

S'il vous plait et comme toujours je compte sur votre aide a fin de résoudre mon problème

 

[Compte Supprimé 979]

Re : Copie ligne avec un TEXTE & problème d'exécution sur le classeur entier

Salut ssassam

Voici ton fichier avec le code suivant

Sub Recap()
  Dim Sht As Worksheet, ShtR As Worksheet
  Dim DLig As Long, NLig As Long
  ' Définir la feuille de récap
  Set ShtR = Worksheets("RECAP")
  ' Trouver la dernière ligne de la colonne C = TOTAL
  DLig = ShtR.Range("C" & Rows.Count).End(xlUp).Row
  ' Effacer le contenu si existe
  If DLig > 1 Then ShtR("A2:C" & DLig).ClearContents
  ' Pour chaque feuille du classeur
  For Each Sht In ThisWorkbook.Sheets
    ' SI la feuille n'est celle de récap
    If Sht.Name <> ShtR.Name Then
      ' Trouver la dernière ligne de la colonne F = TOTAL
      DLig = Sht.Range("F" & Rows.Count).End(xlUp).Row
      ' Trouver la prochaine ligne vide de la feuille RECAP
      NLig = ShtR.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Row
      ' inscrire le montant dans la feuille RECAP
      ShtR.Range("A" & NLig).Value = Sht.Range("B13")
      ShtR.Range("B" & NLig).Value = Format(Sht.Range("F13"), "dd/mm/yyyy")
      ShtR.Range("C" & NLig).Value = Sht.Range("F" & DLig)
    End If
  Next Sht
End Sub

A+

 

[ssassam]

Re : Copie ligne avec un TEXTE & problème d'exécution sur le classeur entier

Merci BrunoM45

c'est génial ton code avec ce fichier test de la même forme , mais ce n'est pas le cas avec mon fichier d'origine je n'ai pas toujours le mot Total ou ref facture dans la même ligne c'est pour ça que je suis obligé d'utilisé la méthode If ColoneA = "TOTAL TTC" Then .... ou Look like..

Merci si tu peux m'aider

 

[Si...]

Re : Copie ligne avec un TEXTE & problème d'exécution sur le classeur entier

salut

dans la page de code de l'onglet "RECAP" (click bouton droit sur ce nom d'onglet puis visualiser le code)

Private Sub Worksheet_Activate()
  Dim O As Worksheet
  Dim Dl As Long, L As Long
  Range("A2:C" & Cells(Rows.Count, 3).End(xlUp).Row + 1).ClearContents
  For Each O In Sheets
    If O.Name <> Me.Name Then
        Dl = Cells(Rows.Count, 3).End(xlUp).Row + 1
       L = O.[A:A].Find("TOTAL TTC").Row
       Cells(Dl, 1).Value = O.[B13]
       Cells(Dl, 2).Value = CDate(O.[F13])
       Cells(Dl, 3).Value = O.Cells(L, 6)
     End If
  Next
End Sub

La mise à jour se fait dès que cet onglet est sélectionné.

 

[ssassam]

Re : Copie ligne avec un TEXTE & problème d'exécution sur le classeur entier

Mr Si... mes salutation les plus sincère c'est une merveille ce que tu as fait c'est exactement est plus automatisé a ce que je cherché