Microsoft Excel - rage copy with macro - Asked By John on 08-Nov-12 09:23 PM

A1 TO A6 is header. I WANT TO COPY TO NEW WORKBOOK  I7 TO LAST COLUM WITH CONTAINS =Y.
HOW TO CHANGE THIS MACRO.

1 AAMLKI RASAYAN -100GM 65 200 20.63 5     Y
2 AAMVATARI RAS-20GM 35 400 20.63 5     Y
3 AAROGYA DALIA (PUSHTAHAR) -500GM 30 30 20.63 5     Y
4 AAROGYA VARDHANI VATI 20GM 40 400 20.63 5     Y
5 AAROGYA VARDHANI VATI 40GM 80 400 20.63 5     Y
6 ABHAYARISHTA-450ML 60 20 20.63 5     Y
7 ABHRAK BHASM -5GM 13 200 20.63 5      
8 AJMODADI CHURN-100 GRM 30 100 20.63 5      
9 AKIK PISHTI - 5GM 15 200 20.63 5      
10 AMLA CANDY 500 GRM 110 24 20.63 5      
11 AMLA CHATPATA -500GM 115 24 20.63 5     Y
12 AMLA CHURNA -100GM 20 100 20.63 5 1000   Y
13 AMLA MURRABA -1KG 100 12 20.63 5      
14 AMRIT RASAYAN 1 KGS 160 12 20.63 5      





Sub Report()

    Dim sht As Worksheet, wb As Workbook
    Dim lastrow As Long, counter As Long
   
    Application.ScreenUpdating = False
    Set wb = Workbooks.Add
   
    For Each sht In ThisWorkbook.Worksheets
      With sht
        lastrow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("AG1:AG6") = True
        .Range("AG7").Formula = "=I7=Y"
        .Range("AG6").AutoFill Destination:=.Range("AG6", .Cells(lastrow, "AG")), Type:=xlFillDefault
        If WorksheetFunction.CountIf(.Range("AG6:AG" & lastrow), True) > 0 Then
          .Columns("AG").AutoFilter Field:=1, Criteria1:="True"
          .Range("A1").CurrentRegion.EntireRow.Copy Destination:=wb.Sheets(1).Range("A" & counter + 1)
          counter = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
        End If
        .Columns("AG").AutoFilter
        .Columns("AG").ClearContents
      End With
    Next sht
   
    Application.ScreenUpdating = True
End Sub

Harry Boughen replied to John on 10-Nov-12 03:31 AM
Hello John,

It is a bit unclear what you want to do but maybe this will serve to get you along the way.  It will be easily adapted to deal with your later post.
Sub Report()

    Dim sht As Worksheet, wb As Workbook
    Dim lastrow As Long, counter As Long
    Dim rngInclude As Range, c As Range

   
    Application.ScreenUpdating = False
    Set wb = Workbooks.Add
    counter = 6
   
    For Each sht In ThisWorkbook.Worksheets
    With sht
      lastrow = .Range("A" & Rows.Count).End(xlUp).Row
      Set rngInclude = .Range("I1:I" & lastrow)
      For Each c In rngInclude
      If c.Value = "Y" Then
        c.EntireRow.Copy Destination:=wb.Sheets(1).Range("A" & counter + 1)
      counter = counter + 1
      End If
      Next c
    End With
    Next sht
   
    Application.ScreenUpdating = True
End Sub

Regards

Harry