从所有工作表中提取一些数据并复制到另一张工作表中答案

【问题标题】：extract some data from all sheet et copy in another sheet从所有工作表中提取一些数据并复制到另一张工作表中
【发布时间】：2021-06-09 11:00:20
【问题描述】：

sheet client capture erreur code

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

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

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

【问题讨论】：

尝试在工作表中显示示例数据，根据您的描述，不清楚为什么代码不起作用。大概什么时候应该匹配结果
我放了一张错误代码的图像。它说“recherche”是一个排位赛是不正确的。（这可能不是唯一的问题）
不，我的意思是你的excel数据的图像......
图一：这就是你所需要的？
嗯，像这样，让我看看，会为你工作，但我现在有点忙，所以今天可能不是。顺便说一句，如果您找到了客户名称，您需要将哪些信息复制到new sheet？地址、邮件和电话？

标签： excel vba find copy worksheet

【解决方案1】：

根据您的信息，我已修改您的代码并允许使用相同名称多次添加新工作表，如果添加了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，新的工作表将通过复制`Range A1:B4'添加，否则什么都不会发生，请尝试根据需要调整它：

合并表

【讨论】：

非常感谢你，差不多就是这样。我只是需要提取客户的邮件并将所有这些邮件放在一张纸上。
尝试用图片解释？因为你没有提到这一步，你想从所有不匹配的客户端事件中提取邮件？
我已经发布了一个答案，希望得到更多解释，如果对你来说更清楚，我说；如果没有，我会再次托盘。
我看到了你的新更新，但我还是不明白email 的范围在哪里？或者您正在将新工作表电子邮件复制到主工作表呼叫Feuliclient？
或者只是将整个工作表复制到新工作表？

【解决方案2】：

Feuil client

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

【讨论】：