Copying cells to another sheet

**Vetequk** · 03-11-2009, 02:02 AM

I would like to be able to copy a group of cells from sheet 1 to sheet 2 or 3 based on a value in another cell on sheet 1 eg
sheet 1
If Cell A1 = 24, A2=London Road (this make up an address), A5= omit

If A5 = omit I would like the address copied to sheet 2
If A5 = Complete I would like it copied to sheet 3

I have 1600 address to go through.

Thanks

Vetequk

**rylo** · 03-11-2009, 02:11 AM

Hi

And where does the next block of data start / end? Is each block 5 rows long and every 5th line has your test requirement?

Perhaps add a small example file with 4 or 5 items, or if your data has different formats/ number of rows, an example of each, and how this example data should be output.

rylo

**Vetequk** · 03-14-2009, 05:58 AM

rylo
I have attached a sample file.
What I am trying to do is filter the list so I can copy all the address that have been omitted to the list sheet, but I only need the the information in the 1st, 2nd & 5th column copied over.

Thanks

Vetequk

**JBeaucaire** · 03-14-2009, 01:39 PM

Your macro seems to work as is for "omit", so you just need to add the "complete" references and another sheet. If the 3rd sheet were called "complete", your macro could expand like so:

Sub Omit()
Dim lastrow As Long
lastrow = Sheets("test").UsedRange.Rows.Count
Application.ScreenUpdating = False

    Range("A8:I" & lastrow).AutoFilter
    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7, Criteria1:="Omit"
    Range("A25:B64").Copy
    Sheets("List").Range("A3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("G25:G" & lastrow).Copy
    Sheets("List").Range("C3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("B79").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("A8:$I" & lastrow).AutoFilter Field:=7
    
    Range("A8:I" & lastrow).AutoFilter
    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7, Criteria1:="Complete"
    Range("A25:B64").Copy
    Sheets("Complete").Range("A3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("G25:G" & lastrow).Copy
    Sheets("Complete").Range("C3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("B79").Select
    Application.CutCopyMode = False
'    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7
Application.ScreenUpdating = True
End Sub

**Vetequk** · 03-14-2009, 11:22 PM

JBeaucaire
Thanks for the reply which has been very helpful, but once the data has been filtered the first cell reference could anthing from A9 to last row. I am trying to find away to assign the cell under A8 (once the data has been filtered) to a string.
This is the code so far:-

Dim FC As String
Dim lastrow As Long
lastrow = Sheets("test").UsedRange.Rows.Count
Application.ScreenUpdating = False

    Range("A8:I" & lastrow).AutoFilter
    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7, Criteria1:="Omit"
    ActiveSheet.Range("A8").Select
    ActiveCell.Offset(1, 0).Select
    FC = ActiveSheet.ActiveCell
    Range(FC & ":B64").Copy
    Sheets("List").Range("A3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("G25:G" & lastrow).Copy
    Sheets("List").Range("C3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("B79").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("A8:$I" & lastrow).AutoFilter Field:=7
Application.ScreenUpdating = True

I have highlighed the area that I think is the problem

Thanks

Vetequk

**JBeaucaire** · 03-15-2009, 01:20 AM

I think this solves the problem, also solves the problem of what to do if there are NO "omit" or "complete" results.:

Sub OmitComplete()
Dim lastrow As Long
lastrow = Sheets("test").UsedRange.Rows.Count
Application.ScreenUpdating = False

    Range("A8:I" & lastrow).AutoFilter
    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7, Criteria1:="Omit"
    On Error GoTo Reset1:       'If there are no "omit" values
    Range("A9:B" & lastrow).SpecialCells(xlCellTypeVisible).Copy
    Sheets("List").Range("A3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("G9:G" & lastrow).SpecialCells(xlCellTypeVisible).Copy
    Sheets("List").Range("C3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("B79").Select
    Application.CutCopyMode = False
    
Reset1:
    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7
    
    Range("A8:I" & lastrow).AutoFilter
    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7, Criteria1:="Complete"
    On Error GoTo Reset2:       'If there are no "Complete" values
    Range("A9:B" & lastrow).SpecialCells(xlCellTypeVisible).Cells.Copy
    Sheets("Complete").Range("A3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("G9:G" & lastrow).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Complete").Range("C3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("test").Range("B79").Select
    Application.CutCopyMode = False
        
Reset2:
    ActiveSheet.Range("A8:I" & lastrow).AutoFilter Field:=7
Application.ScreenUpdating = True
End Sub