HI!
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.
Many thanks!
My code:
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
.Show
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
Next
With Application
.DisplayAlerts = False
NewWb.Sheets(NewWb.Sheets.Count).Delete
.DisplayAlerts = True
NewWb.SaveAs Filename:="Metrics" & " " & InputBox("Enter business name")
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Display More