如何查看一个工作表，并根据其他工作表中的条件复制并粘贴到另一个工作簿中？

Question

早上好。

我有一个包含多个工作表的工作簿。比方说，工作表中&乙

在工作表BI有多个供应商列其中一些对他们有X和他们中的一些不

我想知道怎么做是要如果有在列中出现“X”，然后查看最左边的列（A）并在工作表A中查找该零件编号。

当它在工作表A中找到零件编号时，我想复制所有行和与其关联的列并将其粘贴到全新的工作簿中。

通常零件号码显示在多行上让我们说行1-6，我想要复制的信息跨越多个列让我们说到列“T”。

Answer 1

你的问题是不清楚。 假设你的意思是你有一个workbook与worksheet命名为A和worksheet命名为B，你所描述的算法是这样的：

Sub Test() 
Dim wb as Workbook 
Dim wsA as Worksheet 
Dim wsB as Worksheet 
Dim suppliersRange as Range 
Dim xRange as Range 
Dim searchValue as string 
Dim foundRange as Range 

'The two worksheets in the initial book: 
Set wsA = ThisWorkbook.Worksheets("A") 
Set wsB = ThisWorkbook.Worksheets("B") 

'The supplier column to search: 
Set suppliersRange = wsB.Range("D:D") 'let's assume it column D for now. 

Set xRange = suppliersRange.Find("X") 'Find "X" 

If not xRange is nothing then 
    searchValue = wsB.Range("A" & xRange.Row).value 'Get the value from column A to do the next search 
End If 

Set foundRange = wsA.UsedRange.Find(searchValue) 'Search for this number that we got with the previous step. 

If not foundRange is nothing then 'If it's found 
    Set wb = Workbooks.Add 'Create a new workbook 
    wsA.UsedRange.Copy wb.Worksheets(1).Range("A1") 'And copy Sheet A in there 
End If 

Set foundRange = Nothing 
Set xRange = Nothing 
Set suppliersRange = Nothing 
Set wsA = Nothing 
Set wsB = Nothing 
Set wb = Nothing 

End Sub 

注意，因为你没有指定你的意思与“多行一部分“和/或什么列等 - 我只是复制整个表单内容。当然，您可以过滤出要复制的实际范围，但此代码肯定会为您执行搜索，从工作表A创建新工作簿和复制粘贴。