从另一张工作表中的所有工作表和副本中提取一些数据

问题描述

sheet client capture erreur code

当我可以找到之前输入的引用时，我需要提取单元格名称“_mailclient”中的文本。 代码需要： - 在所有表格中找到参考，放入消息框 - 如果他找到了这个词，他会用引用提取工作表的单元格“_mailclient”并将他放在另一张纸上并传递到下一张纸 - 如果没有，他将传递到下一张纸。 - 重复 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

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

解决方法

根据您的信息，我修改了您的代码并允许使用相同的名称多次添加新工作表，如果添加了 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,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”添加新工作表，否则不会发生任何事情，请尝试根据您的需要进行调整：

组合表

,

Feuil client

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