Copy 2 items to next sheet

  • Thread starter Thread starter RJH
  • Start date Start date
R

RJH

JE McGimpsey was good enough to give me the code below. The code works fine
with one exception, I need it to copy to the last available row on sheet 3
(leaving entries already there intact). I've 'played' with his code but I
can't get it to do this.

Can anyone point me in the direction needed?

Thanks!

Bob Howard







one way:

Public Sub TransferTotals()
Dim rFound As Range
Dim rDest As Range
Dim sFoundAddr As String

Set rDest = Sheets("Sheet3").Range("A2")
Set rFound = Columns(8).Find( _
What:="Total", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=xlFalse)
If Not rFound Is Nothing Then
sFoundAddr = rFound.Address
Do
rDest.Offset(0, 1).Value = rFound.Offset(0,1).Value
rDest.Value = _
rFound.Offset(-2, -6).Value
Set rFound = Columns(8).FindNext( _
After:=rFound)
Set rDest = rDest.Offset(1, 0)
Loop Until rFound.Address = sFoundAddr
End If
End Sub





Columns(8).FindNext(In article
 
<Insert Special Plug Here>
http://www.erlandsendata.no/english/

A great place that holds many great excel vba code and one
of them is a function to find the last available row:

Public Function FindLastRow() As Long
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range

If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
FindLastRow = LastRow
End If
End Function
 
I have tried, for many hours, to get the code (at the end of this post) to
paste it's findings at the end of the existing values on sheet3. Right now
it replaces the values each time I run it. Can anyone help?
Thanks!

Bob Howard

LarryN said:
<Insert Special Plug Here>
http://www.erlandsendata.no/english/

A great place that holds many great excel vba code and one
of them is a function to find the last available row:

Public Function FindLastRow() As Long
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range

If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
FindLastRow = LastRow
End If
End Function



-----Original Message-----
JE McGimpsey was good enough to give me the code below. The code works fine
with one exception, I need it to copy to the first available row on sheet 3
(leaving entries already there intact). I've 'played' with his code but I
can't get it to do this.

Can anyone point me in the direction needed?

Thanks!

Bob Howard







one way:

Public Sub TransferTotals()
Dim rFound As Range
Dim rDest As Range
Dim sFoundAddr As String

Set rDest = Sheets("Sheet3").Range("A2")
Set rFound = Columns(8).Find( _
What:="Total", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=xlFalse)
If Not rFound Is Nothing Then
sFoundAddr = rFound.Address
Do
rDest.Offset(0, 1).Value = rFound.Offset (0,1).Value
rDest.Value = _
rFound.Offset(-2, -6).Value
Set rFound = Columns(8).FindNext( _
After:=rFound)
Set rDest = rDest.Offset(1, 0)
Loop Until rFound.Address = sFoundAddr
End If
End Sub





Columns(8).FindNext(In article
to scan the page
and with the order (2
rows 2 items side by
side


.
Click to expand...
Click to expand...
 
JE McGimpsey are you out there?
You helped greatly with this code but I need help again. As I've written,
the code replaces the data on Sheet3 each time it's run. I need it to run a
continuing list (in other words, I need it to post to the first available
row and the end of the existing data in column 1). I'm not a programmer and
won't be one anytime soon (although I'm doing a lot of book reading and
learning from this group) so I need your help!
Thanks!!

Bob Howard

LarryN said:
<Insert Special Plug Here>
http://www.erlandsendata.no/english/

A great place that holds many great excel vba code and one
of them is a function to find the last available row:

Public Function FindLastRow() As Long
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range

If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
FindLastRow = LastRow
End If
End Function



-----Original Message-----
JE McGimpsey was good enough to give me the code below. The code works fine
with one exception, I need it to copy to the last available row on sheet 3
(leaving entries already there intact). I've 'played' with his code but I
can't get it to do this.

Can anyone point me in the direction needed?

Thanks!

Bob Howard







one way:

Public Sub TransferTotals()
Dim rFound As Range
Dim rDest As Range
Dim sFoundAddr As String

Set rDest = Sheets("Sheet3").Range("A2")
Set rFound = Columns(8).Find( _
What:="Total", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=xlFalse)
If Not rFound Is Nothing Then
sFoundAddr = rFound.Address
Do
rDest.Offset(0, 1).Value = rFound.Offset (0,1).Value
rDest.Value = _
rFound.Offset(-2, -6).Value
Set rFound = Columns(8).FindNext( _
After:=rFound)
Set rDest = rDest.Offset(1, 0)
Loop Until rFound.Address = sFoundAddr
End If
End Sub





Columns(8).FindNext(In article
to scan the page
and with the order (2
rows 2 items side by
side


.
Click to expand...
Click to expand...
 
Yahoo!! I finally figured it out. Thanks for the help in the beginning and
for not helping and leaving me (despite my pleas) to figure out the rest.
You would have enjoyed my happy dance!

Bob Howard
LarryN said:
<Insert Special Plug Here>
http://www.erlandsendata.no/english/

A great place that holds many great excel vba code and one
of them is a function to find the last available row:

Public Function FindLastRow() As Long
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range

If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
FindLastRow = LastRow
End If
End Function



-----Original Message-----
JE McGimpsey was good enough to give me the code below. The code works fine
with one exception, I need it to copy to the last available row on sheet 3
(leaving entries already there intact). I've 'played' with his code but I
can't get it to do this.

Can anyone point me in the direction needed?

Thanks!

Bob Howard







one way:

Public Sub TransferTotals()
Dim rFound As Range
Dim rDest As Range
Dim sFoundAddr As String

Set rDest = Sheets("Sheet3").Range("A2")
Set rFound = Columns(8).Find( _
What:="Total", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=xlFalse)
If Not rFound Is Nothing Then
sFoundAddr = rFound.Address
Do
rDest.Offset(0, 1).Value = rFound.Offset (0,1).Value
rDest.Value = _
rFound.Offset(-2, -6).Value
Set rFound = Columns(8).FindNext( _
After:=rFound)
Set rDest = rDest.Offset(1, 0)
Loop Until rFound.Address = sFoundAddr
End If
End Sub





Columns(8).FindNext(In article
to scan the page
and with the order (2
rows 2 items side by
side


.
Click to expand...
Click to expand...
 
Back
Top