Apply multiple formulas and auto filter the results and copy specific columns from the visible Range

roshanvmech

New Member
Joined
Mar 10, 2014
Messages
2
Hi there,
I am looking for a macro which will apply a formula in the column after the last row of a worksheet and apply filter on the same column for the results and copy the columns 1,2, 4,7 and the column on which the formula is applied and copy only values in the different workbook.
The flow will be like apply formula1 and auto filter on the formula column and copy the specific columns(1,2) and paste in a new workbook in columns 1,2and apply formula 2 and again auto filter on the formula column and copy the specific columns(4,7) and paste the data after the last row in the new work book in columns 1,2.

I tried with the below code but was not working.

HTML:
Sub ConsolidateSheets()
 Dim ms As Worksheet, ws As Worksheet, LR As Long, i As Long, N&
 Dim sWorkBook
    Dim myTableName
    Dim myExcel As Object
    Dim lastrow As Long, erow As Long
    sWorkBook = UserForm_ConsolidateSheet.TextBox_InputFilePath.Value
    Set myExcel = CreateObject("Excel.Application")
    Set myWorkBook = myExcel.Workbooks.Open(sWorkBook)
 
      Application.ScreenUpdating = 0
      Application.DisplayAlerts = 0
    
     On Error Resume Next
    
       If Not Evaluate("ISREF('Results'!A1)") Then
           Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Results"
           Range(A1).Select
           ActiveCell.FormulaR1C1 = "CheckPoint"
           Range(A1).Select
           Selection.Font.Bold = True
       Else
        
          Sheets("Results").Range("A2:I" & Rows.Count).ClearContents
       End If
    
       Set ms = Sheets("Results")
     
    For Each ws In myWorkBook.Sheets
       With ws
        If .Name = "Fields" Then
             ws.Unprotect
             ws.Select
             ActiveWindow.FreezePanes = False
             ActiveWindow.SplitColumn = 0
             ActiveWindow.SplitRow = 1
             ActiveWindow.FreezePanes = True
             ws.Range("BA2").ClearFormats
             ws.Range("BA2").Formula = "=IF(AND($L2=""Text"",NOT($G2=""""),$AC2=""""),IF(LEFT($H2,1)=""$"",IF(VALUE(RIGHT($H2,LEN($H2)-1))>40,""fail"",""""),""""),"""")"
             ws.Range("BA2", "BA" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
             lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
             For i = 2 To lastrow
             If ws.Cells(i, 53).Value = "CP1" Then
             ws.Cells(i, 1).Copy
             erow = ms.Cells(Rows.Count, 1).End(xlUp).Row
             ms.Paste Destination:=Worksheets("Results").Cells(erow + 1, 1)
             ms.Cells(i, 3).Copy
             ms.Cells(Rows.Count, 1).End(xlUp).Row
             ms.Paste Destination:=Worksheets("Results").Cells(erow + 1, 2)
             End If
             Next i
             
         End If
       End With
    Next
             Application.CutCopyMode = 0
             Set ms = Nothing
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
End Sub
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Watch MrExcel Video

Forum statistics

Threads
1,118,862
Messages
5,574,713
Members
412,613
Latest member
EFRATA
Top