View Single Post
  #1   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 ...

[...]
At the moment when there are several dates of the same value in the
column, it will only append the last row of those dates. I need to
append any rows which have the same date as cell A1. Could you please
advise? I looked around but i'm afraid i don't know much about looping
(and evidently everything else in VBA for that matter...)

Regards,

Chris


Ok Chris, only slight modifications: added another
counter (j) to the last For... Next.
Please rerrange as per your need as I worked on my
copy without following your modifications.

--------------------------------------------
Sub CopyRow()
Dim SourceRange As Range, TargetRange As Range
Dim SearchRange As Range, LastWrittenCell As Range
Dim i, n As Integer, k As Integer, j 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 + j, 0)
j = j + 1
End If
Next

End Sub
-----------------------------------

Ciao
Bruno