Need help: find value from multiple wb and ws; copy row and past it in the masterdata wb

Hello,

I am new to this forum and hope really someon can help me to solve my issue.
I would like to give you a shor overview of the macro. The macro with the issue to not can copy the row into ws "Auswertung" is in the wb "Mappe1"


Brief summary of the workbooks “Benutzerform 1”; “Benutzerform 2”; …

In this workbook is a macro to copy from the worksheet “Input” the range “b10:b31” and transpose past the data into one of the worksheets which begin with “Projekt” in the range “d5:ah371” next to the calendar. The macro checks which of the sheets “Projekt” has in range “a1” which is matching with the value of the sheet “Input” in range “b4”. After finding the matching sheet (p.e. Projekt 3), it checks in the column “c5:c371” the match of today date and past the data transposed next to it. In the range “c392:c406” is the monthly resume of the data in range “d5:ah371”.


Brief summary of the workbook “Mappe1”

In this workbook is a macro which looks in the folder “Container of users” (usualy are here 20 wb named "Benutzerform") through all the workbooks. This folder contains all the workbooks “Benutzerform” for each user. In this folder the code find in each workbook and worksheet in the range “c393:c404” (formula of uniting p.e. $A$1&D393) the matching value (wb “Mappe1” ws “Tabelle1” range “a8”) (“a8”formula of uniting “B2&b5”). From each workbook in the folder “Container of users” will be copied from sheet “Input” the range”a3” (name of user) and from the matching sheet “Projekt” the matching value in range “c393:c404” (p.e. 1233 - KluxenApril) and past in the workbook “Mappe1” in the sheet “ Auswertung” in the range “a” (name of user) and “b” (matching value). In the workbook "Mappe1") sheet("Auswertung) is in each row in column "A:A" each name of the user (wb Benutzerform), in column "B:B" the found matched value (which is for each user (Benutzerform) the same). Now it is missing the past value in column c in wb "Mappe1" ws "Auswertung" the row (in range "d393:z404" in wb "Benutzerform").

In the code of the workbook "Mappe1" I am not able to copy the row (one row of t heworkbooks "Benutzerform" worksheets "Projekt" "d393:z404") next to the found value match (wb "Benutzerform" ws "Projekt" range "c393:c404") and past it in the new created sheet "Auswertung" (in the range "C2: y") in the wb "Mappe1".

Please find attached the WTS zip. Change in the module "Ausw" of the wb "Mappe1" the code of the filepath (fpahth) to the path where you saved the folder.

This is the 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
   
  Application.ScreenUpdating = False
  
    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 Test\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
    Application.ScreenUpdating = False
End Sub

I thank you in advance for any help. For any suggestions, doubts or ideas please let me simple know.

Wish you a good day