View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Bruno Campanini[_3_] Bruno Campanini[_3_] is offline
external usenet poster
 
Posts: 52
Default Transfer selected rows to sheet

"chris100" wrote in
message ...

Hi all,

I'm just bringing this up to the top of the list again because i really
need help with this question. At the risk of sounding like i'm begging,
please please please please with sugar on the top help!


Sorry for delay Chris,
Try this sub and let me know if it's ok for you.
You must define n (number of columns),
SourceRange and TargetRange.
It overwrites duplicates in TargetRange.
If you have data in AA10:AE65536 and want to
append the result of search to AG10:AK65536
you must state:
n = 5
SourceRange = [AA10]
TargetRange = [AG10]
The routine will copy to AG10:AK65536 starting from
the first empty cell in column AG10:AG65536

========================================
Sub CopyRow()
Dim SourceRange As Range, TargetRange As Range
Dim SearchRange As Range, LastWrittenCell As Range
Dim i, n As Integer, k As Integer, ItemToSearchFor
'--------------------------------------
' User definitions
n = 5 ' number of columns to append
Set SourceRange = [AA10]
Set TargetRange = [AG10]
'--------------------------------------
Set SearchRange = Range(SourceRange, SourceRange.End(xlDown))
If IsEmpty(TargetRange) Then
Set LastWrittenCell = TargetRange
k = 0
Else
k = 1
If IsEmpty(TargetRange.Offset(1, 0)) Then
Set LastWrittenCell = TargetRange
Else
Set LastWrittenCell = TargetRange.End(xlDown)
End If
End If

ItemToSearchFor = InputBox("Item To Search For:" & vbCrLf & "(case
sensitive)")
If ItemToSearchFor = "" Then
Exit Sub
End If

For Each i In SearchRange
If i.Value = ItemToSearchFor Then
Range(i, i.Offset(0, n - 1)).Copy LastWrittenCell.Offset(k, 0)
End If
Next

End Sub
=====================================

Ciao
Bruno