Copying cells based on limited citeria

**ben5496** · 07-28-2011, 02:22 PM

Hello

I am trying to write a Macro that copys data from one worksheet and pastes it in the other, where it will be pasted will depend on the number of the item (as different numbers will be within two sheets) and whether or not a number has been pasted before it, if it has been pasted then the next dulipate number should be pasted into the next column across

I Have attached a example file to make my explanasion clearer.

thanks

**realniceguy5000** · 07-28-2011, 02:54 PM

Hi,

How about the date? For example you have 2 dates with number 1024 How do you want to handle that issue?

...

**ben5496** · 07-28-2011, 03:02 PM

well I was thinking of doing a count the defenciate between the numbers, so if the number came once, it would add it onto the first cell and so on,

The dates and the numbers will always be different as there is a consildation function, which removes duplicate numbers and dates from the same rows,

I know how to do it but just cant seem to write it as a VB Macro

Thank you

**realniceguy5000** · 07-28-2011, 04:50 PM

Hi, Give This a try:

Sub rng()
Dim cell As Object
Dim r As Range, rr As Range
Dim lrow As Long
Dim rfound As Range
For Each wks In Worksheets
wks.Activate
If wks.Index > 2 Then Exit For
lrow = Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row
Set r = Sheets(3).Range("A3:A" & lrow)
For Each cell In r
                
        Set rfound = wks.Cells.Find(What:=cell, After:=Range("A2"), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
 
        If rfound Is Nothing Then
        
        Else
        
         
                  
        Set rr = wks.Range(Cells(rfound.Row, 3), Cells(rfound.Row, 11))
        
            For Each cel In rr
                     cel.Select
                If Cells(cel.Row, 1).Value = vbNullString Then Exit For
                               
                If IsEmpty(cel) Then
                   cel.Value = cell.Offset(, 1).Value
                    cel.Offset(, 1).Value = cell.Offset(, 2).Value
                    Exit For
                End If
                
            Next cel
           
      
        
        
        End If
  
    
10
Next cell
Next wks
End Sub

Here is a test book as well

...