[Xl 2013]Insérer une ligne vierge sous terme recherché

don_pets

XLDnaute Occasionnel
Bonjour à tous,

je bute sur une macro. L'idée est simple, je souhaite que dans l'ensemble des feuilles d'un fichier, ma macro soit capable de rechercher et d'identifier un début de chaine de caractère contenu dans une cellule et d'insérer une ligne juste en dessous.

Pour l'exemple, je joins une fichier dans lequel ma macro :
- Crée un nouvel onglet ~> ok
- Inspecte l'ensemble des ws, identifie le critère de recherche (dans l'exemple "Total Ref") ~> PAS OK :mad:
- Insère une ligne vierge sous le critère de recherche ~> pas ok :mad:

- Copie / Colle les données voulues dans le nouvel onglet ~> ok (mais pas mit dans le fichier exemple)

A votre bon coeur ^^
Merci par avance de votre aide

pets
 

Pièces jointes

  • Classeur1.xls
    36.5 KB · Affichages: 69
  • Classeur1.xls
    36.5 KB · Affichages: 72
  • Classeur1.xls
    36.5 KB · Affichages: 75

CHALET53

XLDnaute Barbatruc
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

Bonjour,

Mets ce programme dans un module et teste le
L'élément à rechercher est en C1 (feuille Index): Total Ref dans le cas présent

Sub recherche()
Application.ScreenUpdating = False
rech = Sheets("Index").Range("C1")
For Each sh In ActiveWorkbook.Sheets
a = sh.Name
If sh.Name = "Index" Then GoTo suite
Sheets(a).Select
Set Plage = Sheets(a).Range("A:A")
With Plage
Set c = .Find(rech)
If Not c Is Nothing Then
adresse = c.Address
'a = Range(adresse).Row
'Stop
Do
Range(c.Address).Offset(1, 0).Select
Selection.EntireRow.Insert
' Stop
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> adresse
End If: End With: Beep
suite:
Next
End Sub

a+
 
Dernière édition:

vgendron

XLDnaute Barbatruc
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

Bonjour

avec ce code ;-)

Code:
Sub cherche()
For Each ws In Worksheets
    MsgBox ws.Name
    With ws.Range("a1:a500")
        Set c = .Find("Total Ref", LookIn:=xlValues)
        If Not c Is Nothing Then
            ici = c.Row
            .Rows(ici + 1).EntireRow.Insert
        End If
    End With
    
Next ws


End Sub
 

don_pets

XLDnaute Occasionnel
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

Impec, génial.

Effectivement la première soluce m'insère bien une ligne à chaque fois qu'est trouvé le terme total ref, e la seconde ne le fait que pour le premier terme trouvé.

En tout cas merci pour tout!
 

don_pets

XLDnaute Occasionnel
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

Bon en fait je suis allé un peu super plus vite que la musique,

car ça coince encore pour le dernier point.

Pour la partie insertion ça roule, par contre là où je pensais que ce serait simple... je me suis fourré le clavier dans l'Excel !

Pour reprendre mon fichier exemple, je n'arrive pas à trouver la méthode pour faire un Selection.CurrentRegion.Select sur un client donné (disons clientX) et de les coller sur une new_Feuil.

pets
 

Pièces jointes

  • Classeur1.xls
    44 KB · Affichages: 68
  • Classeur1.xls
    44 KB · Affichages: 70
  • Classeur1.xls
    44 KB · Affichages: 73

vgendron

XLDnaute Barbatruc
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

Bonjour,

il te suffit de rajouter d'abord ta nouvelle feuille (ici nommée truc)

Code:
Sheets.Add
ActiveSheet.Name = "truc"

Sheets("Feuil2").Select
Range("A12").CurrentRegion.Copy Destination:=Sheets("truc").Range("C12")
 

don_pets

XLDnaute Occasionnel
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

^^ yes, ça je maîtrise bien,

mon hic c'est de joindre ça à un find. Du genre j'opte pour faire une sélection sur tel ou tel client (ici le clientX), et de prendre tout les tableaux où il est présent et de les coller sur une new_feuil.

Dans l'exemple, je devrais avoir "2 tableaus sur les 3" de coller sur une nouvelle feuille.

Pardon si je ne suis pas très clair, mais j'ai un peu la tête dans le sac @__@

En tout cas merci du coup de main
 

don_pets

XLDnaute Occasionnel
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

yes, enfin dans mon "produit fini" je ferais un bouton/macro par client. Donc dans l'idée oui une nouvelle feuille par client, et ici par exemple une feuille "clientX" dans laquelle j'aurais mes 2 tableaux
 

vgendron

XLDnaute Barbatruc
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

Re

alors. avec ce code
Code:
Sub test()

' Séparation des totaux
Application.ScreenUpdating = False
rech = "total ref"
i = 1
For Each sh In ActiveWorkbook.Sheets
    a = sh.Name
    If sh.Name = "Index" Then GoTo suite
    Sheets(a).Select
    Set plage = Sheets(a).Range("A:A")
    With plage
        Set c = .Find(rech)
        If Not c Is Nothing Then
            adresse = c.Address
            'a = Range(adresse).Row
            'Stop
            Do
                
                Range(c.Address).Offset(1, 0).Select
                Selection.EntireRow.Insert
                'extraction du client
                NomFeuille = Right(ActiveCell.Offset(-1, 0), 7)
                If WorkSheetExist("NomFeuille") = False Then
                    MsgBox ("nexiste pas")
                    Sheets.Add
                    ActiveSheet.Name = NomFeuille
                End If
                Sheets(a).Activate
                ActiveCell.Offset(-1, 0).CurrentRegion.Select
                
                Selection.Copy Destination:=Sheets(NomFeuille).Range("A1")
            ' Stop
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> adresse
        End If: End With: Beep
suite:
Next

End Sub
    
Function WorkSheetExist(Sheetname As String)
 
Dim wSheet As Worksheet
 
On Error Resume Next
    Set wSheet = Sheets(Sheetname)
        If wSheet Is Nothing Then
                        WorkSheetExist = 0
            On Error GoTo 0
        Else 'Does exist
 
                        WorkSheetExist = 0
            On Error GoTo 0
        End If
        Set wSheet = Nothing
End Function

il y a la fonction WorkSheetExist qui teste la présence ou non d'une feuille
reste 2 soucis avec ce code:
1) lorsqu'on ajoute des onglets, la fonction WorksheetExist ne voit pas les nouvelles feuilles déjà ajoutées. donc. te dit que la feuille n'existe pas alors que si. et donc; plante...
sans doute un souci de refresh..??

2) la copie du client se fait toujours en A1: donc ca écrase..
faut juste lui dire de copier à la dernière ligne:
range("A65536").End(XlUp).offset(1,0)
 

don_pets

XLDnaute Occasionnel
Re : [Xl 2013]Insérer une ligne vierge sous terme recherché

Effectivement ça plantouille, pas con ton idée de dispatcher autant de nouvelles feuilles qu'il y a de clients !
J'envisageais moi de faire une macro spécifique par client. D’où mon envie de mixer un .find avec du copier coller. En fait si j'avais été fortiche j'aurais fait :
- 1 - je sépare d'une ligne sous le total ref
- 2 - je cherche 1 client spécifique dans chacun des onglets (car je pourrais en avoir plusieurs)
- 3 - je sélectionne les tableaux de mon client et je les colle dans une nouvelle feuille.

Mais je ne suis pas fortiche è__é

Pour tout te dire j'étais parti sur un truc du genre :

For Each ws In Sheets
If ws.Name <> "Index" Then
With ws.Cells
Set c = .Find("ClientX", LookIn:=xlValues, lookat:=xlPart)

If Not c Is Nothing Then
firstAddress = c.Address
Do
"jenesaispas".select ' je dois luiç dire de faire un Selection.CurrentRegion.Select sur mon mot trouvé
selection.copy

Set NewFeuil = Worksheets.Add(Sheets(1))
NewFeuil.Name = "ClientX"

sheets("ClientX").Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
trouve = True
End If
End With
End If
Next ws

If Not trouve Then MsgBox ("Nan pas de " & mot & " ici, cherche et trouve aut'chose")
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 892
Membres
101 831
dernier inscrit
gillec