Home > Software engineering >  only paste (or copy) rows with values
only paste (or copy) rows with values

Time:01-10

I'm trying to copy a range to the first empty row on the next sheet. But sometimes there is only 2 rows with values and other times there are 5,6 or 7 rows.

I have this for now:

Private Sub test()

  Application.ScreenUpdating = False
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet

  Set copySheet = Worksheets("Blad1")
  Set pasteSheet = Worksheets("Games")

  copySheet.Range("AG4:AS13").Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

End Sub

It works to get it on the next sheet, but it seems to always take the empty cells that were pasted earlier into account when pasting.

So the first time I click it, I get say 2 filled rows, and 6 empty rows pasted, the next time, it pastes the 2 full rows on the 9th row instead of on the 3rd row. The empty rows on sheet 1 do hold formulas, but they are not present in the destination cells after pasting.

It does do it's jobs when I select those empty cells, press 'delete', and the next time I use the macro, it does paste it on the 3rd row.

Any ideas how to solve this?

Tried looking up a solution, but nothing that really worked. I might have been searching in the wrong direction, so that's why I came here.

CodePudding user response:

Copy Values (Empty vs Blank)

  • You have copied blank cells which are not empty and End(xlUp) detects them.
  • Before using the following, which will not copy blank cells, select the range from the first row below the last row with data to the bottom of the worksheet and press Del to get rid of any blank cells.
Sub CopyValues()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim sws As Worksheet: Set sws = wb.Sheets("Blad1")
    Dim srg As Range: Set srg = sws.Range("AG4:AS13")
    Dim scCount As Long: scCount = srg.Columns.Count
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Games")
    Dim dfCell As Range: Set dfCell = dws.Range("A2")
    Dim dlCell As Range
    With dfCell
        With .Resize(dws.Rows.Count - .Row   1, dws.Columns.Count - .Column   1)
            Set dlCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        End With
        If Not dlCell Is Nothing Then
            Set dfCell = .Offset(dlCell.Row - .Row   1)
        End If
    End With
    
    Dim drrg As Range: Set drrg = dfCell.Resize(, scCount)
    
    Dim srrg As Range
    
    For Each srrg In srg.Rows
        If Application.CountBlank(srrg) < scCount Then
            drrg.Value = srrg.Value
            Set drrg = drrg.Offset(1)
        End If
    Next srrg
    
    MsgBox "Values copied.", vbInformation
    
End Sub
  • Related