View Full Version : Solved: Paste to next empty row
blackie42
04-18-2008, 04:45 AM
Hi,
 
Just putting together a macro that finds rows that are the same on sheet1 and cuts and pastes to sheet2
 
Can any one help with the pasting bit and how I find the next empty row on sheet2
 
many thanks
 
Jon
RichardSchollar
04-18-2008, 04:57 AM
Hi Jon
Assuming column A will always have something in it in a populated row, then you can use this column as a proxy for finding the next empty row:
Sheet1.Range("A30:Z30").Copy
Sheet2.Cells(Rows.Count,"A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
Make sense?
Richard
blackie42
04-18-2008, 05:08 AM
Hi - gettin a bit confused - I ran a macro to cut & paste a row (above my target in fact) from sheet 1 to 2 and tried to use it but confusing myself a bit. Here what I've got. (There are 356 occurrences I want to cut and paste from sheet1 to 2
 
 
Sub findtarget()
Dim target As String, LNUMBY As Long
Dim rNa As Range, 
 
target = "STOPPED"
 
LNUMBY = 356
 
Do
 
Sheet1.Activate
 
Range("A1").Activate
 
LNUMBY = LNUMBY - 1
 
Set rNa = Range("a1")
 
Set rNa = Columns(1).Find(What:=target, After:=rNa, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True)
 
rNa.Offset(-1, 0).EntireRow.Select
Selection.Cut
Sheet2.Activate
 
????
 
loop until LNUMBY = 0
 
end sub
any more help appreciated - or tidy code up?
 
Jon
blackie42
04-18-2008, 05:09 AM
I did click the VBA wrap but didn't seem to work
 
Edit Lucas:  blackie, I fixed your code.  You can always hit the edit button and select the code and hit the vba button if this happens again.....
Headre
04-18-2008, 08:44 AM
r
david000
04-21-2008, 12:03 PM
Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As XlFindLookIn = xlValues, _
    Optional LookAt As XlLookAt = xlPart, _
    Optional MatchCase As Boolean = False) As Range
     
    Dim c As Range, FirstAddress As String
     
    With Search_Range
        Set c = .Find( _
            What:=Find_Item, _
            LookIn:=LookIn, _
            LookAt:=LookAt, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=MatchCase, _
            SearchFormat:=False) 'Delete this term for XL2000 and earlier
        If Not c Is Nothing Then
            Set Find_Range = c
            FirstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
          
End Function
Sub Stopped()
    Dim MyRange As Range
    Dim Found_Range As Range
    Dim LastRow As Long
    LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row 'or number 1
    Set MyRange = Sheet1.Range("a1:a" & LastRow)
    On Error GoTo Out:
    Set Found_Range = Find_Range("STOPPED", MyRange, xlValues, xlWhole).EntireRow
Out:
    If Found_Range Is Nothing Then
    MsgBox "AUCHTUNG!", vbInformation, "Error"
    Exit Sub
    End If
    Union(Found_Range, Found_Range).Copy Sheet2.Range("a1")
With Sheet2
    .Select
End With
End Sub
blackie42
04-21-2008, 03:00 PM
Thanks v much for reply  code - does work fine however I'd like it to find 'stopped' and copy the row above it.
 
Will see if I can work it out
 
thanks again
 
regards
 
Jon
david000
04-21-2008, 08:55 PM
Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As XlFindLookIn = xlValues, _
    Optional LookAt As XlLookAt = xlPart, _
    Optional MatchCase As Boolean = False) As Range
     
    Dim c As Range, FirstAddress As String
     
    With Search_Range
        Set c = .Find( _
            What:=Find_Item, _
            LookIn:=LookIn, _
            LookAt:=LookAt, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=MatchCase, _
            SearchFormat:=False) 'Delete this term for XL2000 and earlier
        If Not c Is Nothing Then
            Set Find_Range = c
            FirstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
          
End Function
Sub Stopped()
    Dim MyRange As Range
    Dim Found_Range As Range
    Dim LastRow As Long
    LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row 'or number 1
    Set MyRange = Sheet1.Range("a1:a" & LastRow)
    On Error GoTo Out:
    Set Found_Range = Find_Range("STOPPED", MyRange, xlValues, xlWhole).Offset(-1).EntireRow 'Changed to Offset(-1)
Out:
    If Found_Range Is Nothing Then
    MsgBox "AUCHTUNG!", vbInformation, "Error"
    Exit Sub
    End If
    Union(Found_Range, Found_Range).Copy Sheet2.Range("a1")
With Sheet2
    .Select
End With
End Sub
blackie42
04-22-2008, 10:56 AM
Excellent - thanks for tying up both posts
 
regards
 
Jon
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.