generate report - consolidation macro

Dear,

I would like to receive some help with following macro...
I have a master report file : UAT_TEST_CASES_MASTER for which I want to generate a report based upon other input sheets (for example UAT_TEST_CASES_XXX, UAT_TEST_CASES_YYY, ...)

the macro should:
- be included into the master test cases
- insert pop-up message which file to use as input to copy to master file
- copy all lines looping all worksheets of the input file where the column test executor (column I) is completed with a value and pasting it to the same worktab (same name in master).
- when running the macro for multiple users, the macro should not overwrite the lines but continue where the last line was injected.

Objective: to make a consolidation of different input files into one master file.

I hope this is more or less clear
I attach in attachment both example files.

Thanks in advance for your promt assistance!

Erik

I have made a first attempt, however the macro runs but without any result

I would like to copy all not nulmll values that can be column I (looping all the sheets per input file) to the master sheet in the appropriate worktab

Sub Consolidation()

Dim ws1 As Worksheet
Dim dataRNG As Range
Dim LR As Long, LR1 As Long, x As Long
Dim i As Integer

'
' Consolidation Macro
'
FileToOpen = Application.GetOpenFilename("Select the file to upload (*.xlsm), *.xlsm", MultiSelect:=False)

If FileToOpen = "False" Then
Application.Workbooks.Open Filename:=FileToOpen
Else
Exit Sub
End If

Set wb1 = ActiveWorkbook

Set dataRNG = sheetje.Range("I16", "I100")

For Each ws1 In wb1.Worksheets
        If Not ws1.Name = "LKP Values" Then
        If Not ws1.Name = "TOTALS" Then
        If Not ws1.Name = "Guidelines" Then
        If Not ws1.Name = "Report" Then
        If sheetje.Cells(i, 1).Value <> "" Then
            With ws1
                LR1 = .Range("A" & .Rows.Count).End(xlUp).Row
                If Not .AutoFilterMode Then
                    .Range("A15").AutoFilter
                End If
                .Range("A15:M" & LR1).AutoFilter Field:=10
                Set Rng = .AutoFilter.Range
                x = Rng.Columns(10).SpecialCells(xlCellTypeVisible).Count - 1
                If x >= 1 Then
                    .AutoFilter.Range.Offset(1, 0).Copy
                    With ws
                        LR = .Range("B" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & LR).Resize(x, 1).Value = ws1.Range("B4").Value
                        .Range("B" & LR).PasteSpecial
                    End With
                End If
                ws1.AutoFilterMode = False
            End With

        End If
        End If
        End If
        End If
        End If
    Next ws1
    wb1.Close False


End Sub

Hi..

This should do it..

I didn't quite understand what the "ISU" value was meant to be.. so I assumed it was a Name abbreviation (of the Test Executor)...

To test .. I have added a few rows of "AFA" as the executor in your test case workbook for each sheet.. so i autofiltered on Column 9 (not 10).. but this will be easy to change if my assumption is wrong..

Click the button and type "AFA" .. no quotation marks.. into the input box..

It will then loop through each sheet in your test case workbook.. autofilter for any rows that were tested by "AFA" and copy them to the relevant Sheet in your Master Workbook.

I have added both files in a Zip file below..

Private Sub CommandButton1_Click()
    Dim lr As Long, lr2 As Long, n As Long
    Dim CpyRng As Range, CpyToRng As Range
    Dim wb As Workbook
    Dim fname As String, wbname As String, wbstr As String

    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set wb = ThisWorkbook
    myPath = wb.Path & "\"

    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = myPath  'this is the default folder shown
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xl*", 1  'default
        .Show
        If .SelectedItems.Count > 0 Then
            fname = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    Workbooks.Open Filename:=fname
    wbname = Split(fname, "\")(UBound(Split(fname, "\")))

    ISU = InputBox("Enter ISU", "ISU", "")

    With Workbooks(wbname)
        For i = 3 To Worksheets.Count - 1
            wbstr = Workbooks(wbname).Sheets(i).Name

            lr = Workbooks(wbname).Sheets(wbstr).Range("A" & Rows.Count).End(xlUp).Row + 1
            lr2 = ThisWorkbook.Sheets(wbstr).Range("A" & Rows.Count).End(xlUp).Row + 1
            Workbooks(wbname).Sheets(wbstr).Range("A15:M" & lr - 2).AutoFilter 9, ISU
            n = Sheets(Sheets(i).Name).Range("A15:M" & lr - 2).SpecialCells(12).SpecialCells(2).Count

            If n > 13 Then
                'Setup the Ranges to Copy From and To
                Set CpyRng = Workbooks(wbname).Sheets(wbstr).Range("A15:M" & lr - 2).Offset(1).SpecialCells(12)
                Set CpyToRng = ThisWorkbook.Sheets(wbstr).Range("A" & lr2)
                CpyRng.Copy Destination:=CpyToRng
            End If
        Next i
    End With

    With Application
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Hi Apo! Thanks for your feedback! I have run your macro on the master sheet in attachment using as input the file UAT TEST CASES EHE but I get the following error:

Workbooks(wbname).Sheets(wbstr).Range("A15:M" & lr - 2).AutoFilter 9, ISU
Run-time error 1004: application defined or object defined error

Also when running your macro on the sheets you have provided I get the same error..

Aha it worked, I 'll try to finetune it and see what it brings, keep you posted!

Indeed, I found it also out!
working well now! super!! thanks a lot!!!!