循环每个工作表以查找匹配的值并将整行粘贴到主工作表

时间:2017-09-20 04:48:04

标签: excel vba excel-vba

抱歉,我是vba的新手。我想要做的是将不同的工作簿合并到同一文件下的主工作簿中。之后,我需要查看主工作簿中的每个工作表,以查找与输入值匹配的特定列中的值。如果匹配,则将整行复制到主工作簿。

e.g。第2页

PAYING  CASH    20914-351   13796   
CLOSED  AUTOPAY 10515-283   13795   
PAYING  AUTOPAY 10415-152   13794   
PAYING  CASH    10515-146   13793

第3页

CLOSED  AUTOPAY 30215-037   13792   
PAYING  AUTOPAY 20914-351   13791   
PAYING  CASH    10415-221   13790

如果表2中的输入值,表3与C列中的20914-351匹配,则整行复制到主表

PAYING  CASH    20914-351   13796

PAYING  AUTOPAY 20914-351   13791

我从某个地方复制并让它为合并部分工作。非常感谢你!

Private Sub CommandButton1_Click()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "C:\Users\ISS-KTHP-001\Desktop\Accom Master File\"
fileName = Dir(directory & "*.xlsx")

Do While fileName <> ""
Workbooks.Open (directory & fileName)
    WrdArray() = Split(fileName, ".")
    For Each sheet In Workbooks(fileName).Worksheets
    Workbooks(fileName).ActiveSheet.Name = WrdArray(0)
        total = Workbooks("Book2.xlsm").Worksheets.Count
        Workbooks(fileName).Worksheets(sheet.Name).Copy     after:=Workbooks("Book2.xlsm").Worksheets(total)

        GoTo exitFor:

    Next sheet

exitFor:
Workbooks(fileName).Close
fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

0 个答案:

没有答案