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

时间:2017-07-07 12:00:59

标签: excel vba excel-vba

早上好。

我有一个包含多个工作表的工作簿。让我们说工作表A&乙

在工作表B中,我有多个供应商列,其中一些列有X,其中一些没有

我想知道的是,如果有一个" X"在列中显示然后查看最左边的列(A)并在工作表A中查找该部件号。

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

通常,部件号显示在多行上,让我们说第1-6行,以及我想要跨多个列复制跨度的信息让我们对Column" T& #34;

1 个答案:

答案 0 :(得分:0)

你的问题不明确。 假设您的意思是您有workbook个名为A的worksheet和名为B的worksheet,您描述的算法是这样的:

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创建新工作簿和复制粘贴。