[/HTML]Hello all! I am new to this forum and hope someone can help me to sort out my problem. I have in a file over 20 workbooks (p.e. Benutzerform 1) with different worksheets (Input, Project 1, Project 2,...) and in a other file a master data workbook (Mappe 1). In the master data workbook I can choose the name of the project and the month. In the different workbooks (Benutzerform #) and sheets finds the project and the month. In the master data workbook will be created a new sheet called "Auswertung" and placed in each row the user name and the month and project. Column a the user name and column b the month and project. Till here I could create the vba. I would like that from column c it copy as well the corresponding data of the found match. But unfortunatly I have no idea how I can do it. Maybe someon is able to help me. Thank you in advance for any suggestion! Please find below the code:
HTML:
[CODE]Option Explicit
Sub Ausw()
Dim SumSh As Worksheet
Dim fPath As String ' path of the file
Dim fName As String ' fiename
Dim wb As Workbook ' workbooks
Dim drng As Range 'dest range
Dim srng As Range 'source range
Dim Ws As Worksheet ' worksheets
Dim FindString As String 'find the match
Dim lngLastRow As Range 'row
FindString = Sheets("Tabelle1").Range("a8") 'source of match
Set SumSh = Worksheets.Add 'add new sheet
ActiveSheet.Name = "Auswertung" ' name of new sheet
fPath = "C:\Users\pa054756\Desktop\WTS Probe - Kopie\" ' file path
fName = Dir(fPath & "*.xl*")
Do While fName <> ""
Set wb = Workbooks.Open(fPath & fName)
SumSh.Range("A" & Rows.Count).End(xlUp)(2).Value = Sheets("input").Range("b3") 'source for person
'lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'row
For Each Ws In ActiveWorkbook.Worksheets
If Trim(FindString) <> "" Then
With Ws.Columns(3) '("c:C" & lngLastRow)
Set srng = .Find(What:=FindString, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) 'what to find
End With
If Not srng Is Nothing Then
Set drng = SumSh.Range("B" & Rows.Count).End(xlUp)(2)
Set drng = drng.Resize(srng.Rows.Count, srng.Columns.Count)
drng.Value = srng.Value
End If
End If
Next Ws
wb.Close False
fName = Dir()
Loop
End Sub
[/CODE]