I've created the macro below for the purpose of some reporting.
It works in the following way:
1. User opens the UserForm, when he or she can select the relevant column name (col) and value to look for (strName).
2. Macro should now loop thourght the specific sheets and for each and every case, when it finds a match - simply copy/paste visible cells into new file/separate sheets.
Now the 2 problems, which I have with this macro occurs at line:
1. I can't add more than 3 sheets to an array, as I receive error: "autofilter method of range class failed"
2. Macro for some reason copies the data from 1st sheet correctly, however for the rest of spreadsheets it copies only headers (without underling data)
I'd appreciate some suggestions on how this can be fixed.
- Sub Create_MIS_A()
- Dim Wb As Workbook, NewWb As Workbook, Ws As Worksheet, cfind As Range, strName As String, col As String
- Application.ScreenUpdating = False
- Application.Calculation = xlCalculationManual
- Set Wb = ThisWorkbook
- Set NewWb = Workbooks.Add
- ''''''Below is only manual search'''''''
- 'col = InputBox("Select column name [L]")
- 'strName = InputBox("Enter business name")
- With UserForm1
- col = .ComboBox1.Value
- strName = .ComboBox2.Value
- End With
- Unload UserForm1
- For Each Ws In Wb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")) '<-- change sheet names as needed
- With Ws.Range("A1", Ws.Cells(1, Ws.Columns.Count).End(xlToLeft))
- If .Parent.AutoFilterMode Then .Parent.AutoFilter.ShowAllData
- Set cfind = .Find(what:=col, LookIn:=xlValues, lookat:=xlWhole)
- If Not cfind Is Nothing Then
- 'when adding more than 3 sheet error here
- .AutoFilter Field:=cfind.Column, Criteria1:="*" & strName & "*"
- .Parent.UsedRange.Cells.SpecialCells(12).Copy NewWb.Sheets(NewWb.Sheets.Count).[A1]
- NewWb.Sheets.Add After:=NewWb.Sheets(NewWb.Sheets.Count)
- End If
- End With
- With Application
- .DisplayAlerts = False
- .DisplayAlerts = True
- NewWb.SaveAs Filename:="Metrics" & " " & InputBox("Enter business name")
- .ScreenUpdating = True
- .Calculation = xlCalculationAutomatic
- End With
- End Sub