Results 1 to 5 of 5
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Copy Data where value is not zero or Blank

    I would like to copy data on Sheet1 in Col A where the values in Col E is not zero or blank to sheet 2 Col A below the last data containing values


    Your assistance in this regard is most appreciated


    I have written code to copy from sheet1 to sheet2 , but need this modified to suit my requirements


    Code:
      Sub Copy_data()
    
    Dim Lr As Long
        With Sheets("sheet1")
            Lr = .Cells(Rows.Count, "A").End(xlUp).Row
            .Range("A2:A" & Lr).Copy
        End With
        With Sheets("sheet2")
            .Range("A2").PasteSpecial Paste:=xlPasteValues
        End With
    End Sub
    Attached Files Attached Files

  2. #2
    2 Star Lounger
    Join Date
    Aug 2011
    Posts
    112
    Thanks
    35
    Thanked 3 Times in 3 Posts
    Hi Howard,

    See if this gets you started.

    Code:
    Sub Copy_data()
        Dim Lr As Long
        Dim i As Long
        Application.ScreenUpdating = False
        With Sheets("Sheet1")
            Lr = .Cells(Rows.Count, "A").End(xlUp).Row
            For i = 1 To Lr
                If .Cells(i, 5).Value <> 0 Then
                    .Cells(i, 1).Copy
                    Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                End If
            Next i
        End With
        Application.ScreenUpdating = True
    End Sub
    If you had a header on Sheet1 you could even just filter for <> 0 and then copy all at once

  3. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks for your help and input. Code works perfectly

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Jrb & Howard,

    Some efficiency tweaks and minor fixes.

    Code:
    Option Explicit
    
    Sub Copy_data()
    
        Dim Lr      As Long
        Dim i       As Long
        Dim NextRow As Long
        
        Application.ScreenUpdating = False
        NextRow = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row
        NextRow = NextRow + IIf(NextRow = 1, 0, 1) '*** Allow for empty sheet 2
        
        With Sheets("Sheet1")
            Lr = .Cells(Rows.Count, "A").End(xlUp).Row
            For i = 1 To Lr
            
                If .Cells(i, 5).Value <> 0 Then
                    .Cells(i, 1).Copy
                    Sheets("sheet2").Cells(NextRow, 1).PasteSpecial Paste:=xlPasteValues
                    Application.CutCopyMode = False  '*** Turn off marquee ***
                    NextRow = NextRow + 1
                End If
                
            Next i
            
        End With
        
        Application.ScreenUpdating = True
        
    End Sub
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. The Following User Says Thank You to RetiredGeek For This Useful Post:

    jrb (2016-04-12)

  6. #5
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks RG for your code

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •