Résolu :copier des ligne variable entre 2 cellule variable

[kevenpom]

Bonjours,

j'ai un document excel qui a importer du texte et
je veut rechercher une certaine valeur (ex. "aa112") dans une cellule (exemple A13)
transférer tout se qui a entre la A13 et la prochaine valeur "aa112" (ligne entiere) dans feuil2 et
faire sa a répétition pour les suivant exemple.
A13 a A40 = FEUIL2
A40 a A68 = FEUIL3
A68 a A112 = FEUIL4

Voici mon code jusqua maintenant voir sub test pour ma question...

Sub Test()
'Déclare la variable
Dim NomTableau() As String
Dim i, k, j, x As Integer
Dim pro As String
pro = "AA123"
j = 0
i = 0
k = 0

x = Application.CountIf(Range("a1:A" & Worksheets("Feuil1").Range("A65536").End(xlUp).Row), prohydraulique)
ReDim NomTableau(x)
  
  
With Worksheets("Feuil1").Columns(1)
    For i = 0 To Worksheets("Feuil1").Range("A65536").End(xlUp).Row
        Set C = .Find(pro, LookIn:=xlValues, LookAt:=xlWhole)
        If Not C Is Nothing Then
            NomTableau(j) = C.Row
            j = j + 1
        End If
    Next i
        
End With
    
End Sub

Sub Worksheet_Change()
    Application.ScreenUpdating = False
    Dim y As String, SH As Integer
    SH = 0
    On Error Resume Next
    
    For SH = 1 To Worksheets.Count
        y = Val(Mid(Sheets("Feuil" & SH).Range("A14"), InStr(Sheets("Feuil" & SH).Range("A14"), ":") + 1))
        Sheets("Feuil" & SH).Name = y
    Next SH
    Application.ScreenUpdating = True
End Sub

Enfin peut être que je suis dans le champ avec ma sub test() mais ses pour sa que j'écrit car je suis confu.
je laisse un exemple de mon fichier excel
Merci

 

[kevenpom]

Re : fonction find avec texte

Sa ne marche toujour pas
comment faire ???

Merci en avance.

 

[kevenpom]

Re : copier des ligne variable entre 2 cellule (pour les amateur de sport)

J'ai finalement réussi a faire se que je voulait...
Merci à vous tous car j'ai fait toutes mes recherches sur ce forum.

voici mon code pour partager avec les autres :
si vous avez des amélioration ou question allez-y

Sub traitement()
'Déclarer les variables
Dim pro, y, NomTableau() As String
Dim i, k, j, x, last, lastmail, lastcount, lastcount1 As Integer
c = 0: k = 0: i = 0: j = 0
last = Worksheets("importation").Range("A65536").End(xlUp).Row
pro = "*418-6*"

'redimensionne le tableau en fonction du nombre de variable pro
x = Application.CountIf(Range("A1:A" & last), pro)
ReDim NomTableau(x)

'stockage dans NomTableau() les numéro ligne qui contienne la variable pro
With Worksheets("importation").Range("A1:A" & last)
    Set c = .Find(pro, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        NomTableau(j) = c.Row
        j = j + 1
        Do
            Set c = .FindNext(c)
            NomTableau(j) = c.Row
            If j < x Then j = j + 1
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

'redimmensionne le tableau pck le dernier element est égal au premier
ReDim Preserve NomTableau(0 To (x - 1))

For j = 0 To x - 1
    If j < x - 1 Then
        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
        t = 0
        Worksheets(Worksheets.Count).Range("A1:G" & NomTableau(j + 1) - NomTableau(j) - 13) = Worksheets("importation").Range("A" & NomTableau(j) + 5 & ":G" & NomTableau(j + 1) - 9).Value
    Else
    End If
    
    'trouve le numéro de fournisseur dans le texte et le trim
    y = Val(Mid(Sheets(Worksheets.Count).Range("A1"), InStr(Sheets(Worksheets.Count).Range("A1"), ":") + 1))
    y = Trim(y)
    
    'lorsque le fournisseur a plus d'une page il copie la 2em apres la premiere et vide les cellule de la 2em
    If Worksheets(Worksheets.Count - 1).Name = y Then
        lastcount = Worksheets(Worksheets.Count).Range("A65536").End(xlUp).Row
        lastcount1 = Worksheets(Worksheets.Count - 1).Range("A65536").End(xlUp).Row
        Worksheets(Worksheets.Count - 1).Range("A" & lastcount1 + 2 & ":G" & lastcount1 + lastcount - 4) = Worksheets(Worksheets.Count).Range("A6" & ":G" & lastcount).Value
        Worksheets(Worksheets.Count).Range("A1" & ":G" & lastcount).Value = ""
        
    'si juste une page la renomme le no de fournisseur et vérifie avec les emial fournisseur pour des nouveau
    Else
        Worksheets(Worksheets.Count).Name = y
        lastmail = Worksheets("email").Range("A65536").End(xlUp).Row
        Set c = Worksheets("email").Range("A1:A" & lastmail).Find(Trim(y), LookIn:=xlValues)
        If Not c Is Nothing Then
        Else
            Worksheets("email").Range("A" & lastmail + 1) = y
            Worksheets("email").Range("B" & lastmail + 1) = Sheets(Worksheets.Count).Range("A1")
        End If
    End If

Next j

End Sub