Finding next blank row and pasting problem

**koklok** · 11-19-2008, 10:39 AM

What I’m trying to do here is to auto filter everything and then filter column 4 for “20”
Copy the filtered area to a “TR 53 Div” sheet and delete it from original “TR 53 Other” sheet.
Next step is to do similar thing by filtering for “50” and copying it, but my problem is pasting it to a “TR 53 Div” sheet that already contains info for “20” and what I need to do is to find the next blank row in “TR 53 Div” sheet and paste “50”.

So, the bottom line is that I need a formula that will find the next blank row in “TR 53 Div” sheet so that I’m able to paste the next thing.

Selection.AutoFilter Field:=4, Criteria1:="20"
    Rows("110:112").Select
    Selection.Copy
    Sheets("TR 53 Div").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("TR 53 Other").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("D1").Select
    Selection.AutoFilter Field:=4, Criteria1:="50"
    Rows("217:238").Select
    Selection.Copy
    Sheets("TR 53 Div").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("TR 53 Other").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("D1").Select

**royUK** · 11-19-2008, 10:55 AM

Your code can be a made more efficient. It needs to only copy filtered rows, currently it will copy all rows.

Attach an example workbook & state exactly what to filter, and where to copy to.

**koklok** · 11-19-2008, 01:30 PM

Please see attached

**koklok** · 11-19-2008, 06:20 PM

Originally Posted by koklok

Please see attached

Anybody ???

**royUK** · 11-20-2008, 04:42 AM

Try this code

Option Explicit

Sub filter2050()
    Dim wsData As Worksheet
    Dim wsTarget As Worksheet
    Dim rFilter As Range
    Dim rCopy  As Range
    Dim i      As Integer
    Dim y      As Integer
    Dim Rw     As Long

    Set wsData = Sheet1
    Set wsTarget = Sheet2

    With wsData
        Set rFilter = .Range(.Cells(1, 1), .Cells(.Rows.Count, 6).End(xlUp))

        For i = 1 To 2
            y = Choose(i, 20, 50)
            With wsTarget
                Rw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            End With
            rFilter.AutoFilter Field:=4, Criteria1:=y
            Set rCopy = rFilter
            If Rw = 2 Then
                rCopy.Copy wsTarget.Cells(1, 1)
            Else: Set rCopy = .Range(.Cells(2, 1), .Cells(.Rows.Count, 6).End(xlUp))
                rCopy.Copy wsTarget.Cells(Rw, 1)
            End If
        Next i
        rFilter.AutoFilter
    End With
End Sub

**koklok** · 11-20-2008, 10:40 AM

Roy,

Thanks for help but code only works in new workbook or the example
However when I try using it in my actual workbook it doesn't work
I'm little confused with your code because it doesn't refer to any of the sheets that are in example (ALL , or 20&50)
I tried changing your code where it has sheet 1 or sheet 2 but it doesn't work, and I tried many changes but still nothing
Any sugestions what I'm doing wrong?

**royUK** · 11-20-2008, 11:47 AM

Have a look at the VB Editor and you will see the worksheets in the workbook listed in the Project Window at the left. In the example

Sheet1(All)
Sheet2(20 & 50")

You can refer to sheets in code with

Sheets("All") - this is the Sheet name and will fail if the sheet is renamed
Sheets(1) - this is the sheet Index and will fail if the sheet is moved
Sheet1, outside the brackets, is the code name & can only be changed by accessing the
VB Editor. This is generally the best one to use

Look at your workbook to get the code name

Finding next blank row and pasting problem

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Finding next blank row and pasting problem

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions