extract some data from all sheet et copy in another sheet

Question

sheet client capture erreur code

i need to extract the text in the cells names "_mailclient" when i can find ref previously enter. the code need to : -find in all sheet the reference, put in the messge box -if he find the the word, he extrait the cells "_mailclient" of the sheet with the ref and put him in another sheet and pass to the next sheet -if not he pass to the next sheet. -repet the code for evely sheet. Thanks for your time

Sub recherche_mail()

Dim feuille As Worksheet
Dim valeurtrouve As Range
Dim recherche As String
Dim nomclient As String

'Intéger reference for FIND 
recherche = InputBox("Pour quel réparation doit je extraire les clients ?", "référence de la 
réparation")

'for every sheet in ThisWorkbook.Worksheets
For Each feuille In ThisWorkbook.Worksheets

'affect the variable to valeurtrouve
Set valeurtrouve = feuille.Range("C8:C10000").Find(recherche, , xlValues, xlWhole)

'if valeur trouve was find copy it 
If valeurtrouve.Value = recherche.Value Then

'and paste in another sheet
Sheets.Add.Name = "liste client"
Sheets("listeclient").Range("A1").Cells.Range("_mailclient").Copy
Range("A2").Select
End If
Next feuille

'if isn't find next sheet
If Not valeurtrouve Is Nothing Then Exit For
Next feuille

'if no more sheet exit and message box and sub 
If Not valeurtrouve Is Nothing Then
MsgBox (" la liste a été créer "), True
Else

'if no people was find message box and sub
MsgBox "Personne n'a cette rèf ... va falloir bosser un peu plus", vbInformation
End If

End Sub

I hope it's clear, i'm a begginer please be indulgent :')

Answer 1

Based on your information, I have modified your code and allow add new sheet multiple times using same name, and if new sheet added then will display successful message :

Sub recherche_mail()

Dim feuille As Worksheet, newWb As Worksheet
Dim valeurtrouve
Dim recherche As String

Dim i As Long, colNum As Long
Dim searchResult As Boolean

'Intéger reference for FIND
recherche = InputBox("Pour quel réparation doit je extraire les clients ?", "référence de la réparation ")
searchResult = False

colNum = 1

'for every sheet in ThisWorkbook.Worksheets
For Each feuille In ThisWorkbook.Worksheets

    'affect the variable to valeurtrouve
    valeurtrouve = feuille.Range("C8:C10")

If searchResult = True Then
        For i = LBound(valeurtrouve) To UBound(valeurtrouve)
        If InStr(CStr(valeurtrouve(i, 1)), recherche) > 0 Then
            feuille.Range("B1:B4").Copy newWb.Cells(1, colNum)
            colNum = colNum + 1
        End If
    Next
End If


If searchResult = False Then
    For i = LBound(valeurtrouve) To UBound(valeurtrouve)
        If InStr(CStr(valeurtrouve(i, 1)), recherche) > 0 Then
            Sheets.Add.Name = "liste client"
            Set newWb = ThisWorkbook.Worksheets("liste client")
            feuille.Range("B1:B4").Copy newWb.Cells(1, colNum)
            colNum = colNum + 1
            searchResult = True
            
        End If
    Next
End If

Next feuille


If searchResult = False Then
    MsgBox (" No record is found "), vbOKOnly
Else
    MsgBox "People found and new sheet created"
End If

End Sub

Let say if you key in RVA in the input box, new sheet will be added by copy `Range A1:B4' else nothing will happen, please try and adjust it for your need:

Combine Sheet