[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
 

Fichiers joints

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
 

CHALET53

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

Bonjour Vgendron

ok
J'avais interprété que notre ami voulait insérer une ligne après chaque Total Ref

a+
 

vgendron

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

bonjour Chalet
effectivement ;-)
et je me suis dit qu'avec ton .findnext il aurait de quoi faire tout ce qu'il souhaite

a+
 

don_pets

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

Bonjour Chalet et Vgendron,

Merci pour vos retours, pardonnez ma réponse tardive, rdv extérieur oblige !

Je teste de suite les deux propo.
 

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
 

Fichiers joints

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
 

vgendron

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

question: une nouvelle feuille par client?:
cad: dans ton exemple: pour le client X, il y a UNE feuille avec DEUX tableaux.?
 

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")
 

don_pets

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

Si quelqu'un il a une bonne idée j'essaierai de ne pas m'en offusquer hein !
 

Discussions similaires


Haut Bas