从所有 sheet 中提取一些数据并复制到另一个 sheet

Question

sheet client capture erreur code

当我可以找到之前输入的 ref 时，我需要提取单元格名称“_mailclient”中的文本。代码需要： - 在所有 sheet 中找到参考，放入消息框 -如果他找到这个词，他会用 ref 提取 sheet 的单元格“_mailclient”，然后将他放入另一个 sheet 并传递给下一个 sheet - 如果不是他传递给下一个 sheet。 - 重复 evely sheet 的代码。感谢您的宝贵时间

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

我希望它很清楚，我是初学者请放纵:')

Answer 1

根据您的信息，我修改了您的代码，允许使用相同的名称多次添加新的 sheet，如果添加了 new sheet，则会显示成功消息：

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

假设你在输入框里输入RVA，新的sheet会通过复制`RangeA1:B4'来添加，否则不会有任何反应，请尝试调整满足您的需求：

合并Sheet

Answer 2

Feuil client

我需要一个消息框来放置参考，我会搜索
输入参考后，代码将在 sheet 上看到参考是否在此处：如果是：将其复制并粘贴到新的 sheet 中。如果不是他传给下一个
下一个 sheet : 相同的动作。如果他找到了一些东西，他会在与最后一步相同的 sheet 中复制并过去如果不是他传给下一个
最后：如果他找到了一些东西，请在消息框中输入：sheet 创建如果不是：“未找到客户”）

从所有 sheet 中提取一些数据并复制到另一个 sheet

extract some data from all sheet et copy in another sheet

excel

vba

copy

worksheet

find