PDA

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