Excel 2010

[Matrix67]

I'm trying to copy a row of cells from one worksheet to another based on the value in that row, i.e. if the value in column "I" is between 1 & 4 on sheet 1 then copy entire row to a specific row in sheet 2? Can anyone help me? Thank you Marco

 

[saltkev]

Hi

Not sure if you were looking for a VBA solution, however here goes. This works by looking at values in a given range in sheet 1 "A4:A20" if it spots a value between 1 & 4 it copies the entire row to sheet2 beginning range "A4"

If there are several values in sheet1 between 1 & 4 it copies each row into the first available empty cell in sheet 2 after "A4". This can be run under a command button or spread sheet event.

Dim findVAL
Application.ScreenUpdating = False

For Each findVAL In Sheets("sheet1").Range("a4:a20") ' Range Where Value kept
    If findVAL.Value > 0 And findVAL < 5 Then 'Search Criteria
        findVAL.EntireRow.Select
        Selection.Copy                  'copy row containing value
        
             
             
        ' *** Where to Paste Selected Rows  ***
        
        Sheets("sheet2").Activate
        
        
        ' Paste first row in  cell "A4"
        
            If Sheets("sheet2").Range("a4").Value = "" Then
               Sheets("sheet2").Range("a4").Select
               ActiveSheet.Paste
               GoTo ender
            End If
            
            
            
         ' Paste second row in  cell "A5"
            
          Sheets("sheet2").Activate
          
            If Sheets("sheet2").Range("a4").Value > "" And Sheets("sheet2").Range("a5").Value = "" Then
               Sheets("sheet2").Range("a5").Select
               ActiveSheet.Paste
               GoTo ender
            End If
            
         ' Paste subsequent rows in  first available cell at bottom
          Sheets("sheet2").Activate
          
            If Sheets("sheet2").Range("a4").Value > "" And Sheets("sheet2").Range("a5").Value > "" Then
               Sheets("sheet2").Range("a4").Select
               Selection.End(xlDown).Select
               Selection.Offset(1, 0).Select
               ActiveSheet.Paste
               Sheets("sheet1").Activate
            End If
    
ender:
              Sheets("sheet1").Activate
    
    End If
  
Next findVAL