Moving Data from one sheet to a different sheet based on Criteria

  • Thread starter Thread starter DoctorV
  • Start date Start date
D

DoctorV

I have an Excel Workbook with a sheet tab named MainForm that goes ou
and pulls data in from an Access Query using Microsoft Query. Afte
the data is pulled into this tab names MainForm, I need a Macr
Procedure that will pull all records from Sheet tab Main Form (Rang
A2:AB65636) where the field in Column AA (column heading Result)
"Alive" into the Sheet named Alive with all of the pertinent records.

Example in sheet MainForm there are 125 records where column headin
Result = Alive. Copy those 125 records into sheet tab alive startin
at cell A2

How can I do this
 
One way:

Sub Macro2()
Dim MaxRange As Range
Application.ScreenUpdating = False
With Sheets("Sheet2")
Set MaxRange = .UsedRange
With .Cells
.AutoFilter Field:=27, Criteria1:="Alive"
Intersect(.SpecialCells(xlCellTypeVisible), MaxRange).Copy
With Sheets("Sheet4")
.Paste
End With
.AutoFilter
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Regards

Trevor
 
Trevor I put this in as a Macro, and it works fine except that it is
copying the title fields in row 1 as well as the data. Is there any
adjustment I can make so that it will just copy the data from Main form
starting at Row2? Thanks for your help!!!

Sub Macro2()
Dim MaxRange As Range
Application.ScreenUpdating = False
With Sheets("MainForm")
Set MaxRange = .UsedRange
With .Cells
AutoFilter Field:=27, Criteria1:="Alive"
Intersect(.SpecialCells(xlCellTypeVisible), MaxRange).Copy
With Sheets("Alive")
Paste
End With
AutoFilter
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
See this example on the link I posted
This will not copy the header row

<Add records to the existing sheet>
 
Sub Macro2()
Dim MaxRange As Range
Application.ScreenUpdating = False
With Sheets("Sheet2")
Set MaxRange = .UsedRange
Set MaxRange = _
MaxRange.Offset(1, 0).Resize(MaxRange.Rows.Count - 1,
MaxRange.Columns.Count)
With .Cells
.AutoFilter Field:=27, Criteria1:="Alive"
Intersect(.SpecialCells(xlCellTypeVisible), MaxRange).Copy
With Sheets("Sheet4")
.Paste
End With
.AutoFilter
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Regards

Trevor
 
Back
Top