CODEWITHSUNDEEP
excelvba
WaveWalker116
WaveWalker116

Reputation: 43

Excel VBA Skip Blank when copying to another sheet

I know this has been asked before and I've been reading several other threads about how to skip a blank row when copying data to another sheet, but I can't seem to get those suggestions to work.

My spreadsheet has a form which the user fills out using a drop down. They then can edit the data on the form to fit their specific project, which could include deleting data, which would leave a blank row. Then they hit a button and it copies the data over to another sheet.

Right now, the code copies the data over, but if there's a blank on the form, it creates a blank row on the task list. I'm trying to get that to stop, so that even if there are blanks in the form, when it pastes the data to the task list, they're all row by row.

Here's the code I'm using right now:

Sub Task_Entry()

Application.ScreenUpdating = False

Dim InstalDesc As String
Dim AssignedTo As String
Dim Model As Range
Dim Drawing As Range
Dim Index As Long
Dim m As Long, n As Long

Application.ScreenUpdating = False
'Copy data from the input screen to the task list.
Sheets("Task Entry Form").Select
InstalDesc = Range("D3")
AssignedTo = Range("G2")
Set Model = Range("D5", Cells(Rows.Count, "D").End(xlUp)).Resize(, 2)
Set Drawing = Range("I5", Cells(Rows.Count, "I").End(xlUp)).Resize(, 2)

Index = Range("Q2")
With Sheets("Task List")
    'get last row
    n = .Range("D:X").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    If n = 3 Then n = 4 Else n = n + 2
    'color first row
    .Range("A" & n & ":Z" & n).Interior.Color = 15189684
    .Cells(n, "D") = InstalDesc & " Summary"
    
    Model.Columns(1).Copy
    .Cells(n + 1, "E").PasteSpecial xlPasteValues
    Model.Columns(2).Copy
    .Cells(n + 1, "Q").PasteSpecial xlPasteValues
    
    Drawing.Columns(1).Copy
    .Cells(n + Model.Rows.Count + 1, "F").PasteSpecial xlPasteValues
    Drawing.Columns(2).Copy
    .Cells(n + Model.Rows.Count + 1, "Q").PasteSpecial xlPasteValues

    'get last row after inserting data
    m = .Range("D:X").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    

Range("a2").Select
         
End With
Application.ScreenUpdating = True
Reset_Form

Sheets("Task Entry Form").Select

Range("D3").Select

End Sub

Any help would be most appreciated!

Upvotes: 0

Views: 368

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Please, replace this part:

'your existing code
    Model.Columns(1).Copy
    .Cells(n + 1, "E").PasteSpecial xlPasteValues
    Model.Columns(2).Copy
    .Cells(n + 1, "Q").PasteSpecial xlPasteValues
    
    Drawing.Columns(1).Copy
    .Cells(n + Model.Rows.Count + 1, "F").PasteSpecial xlPasteValues
    Drawing.Columns(2).Copy
    .Cells(n + Model.Rows.Count + 1, "Q").PasteSpecial xlPasteValues
'your existing code

with

'your existing code
  If Model.rows.count > 1 Then
    Model.Columns(1).SpecialCells(xlCellTypeConstants).Copy 'creates a discontinuous range without spaces
    .Cells(n + 1, "E").PasteSpecial xlPasteValues
    Model.Columns(2).SpecialCells(xlCellTypeConstants).Copy
    .Cells(n + 1, "Q").PasteSpecial xlPasteValues
  Else
    Model.Columns(1).Copy
    .Cells(n + 1, "E").PasteSpecial xlPasteValues
    Model.Columns(2).Copy
    .Cells(n + 1, "Q").PasteSpecial xlPasteValues
  End If
  If Drawing.rows.count > 1 Then
    Drawing.Columns(1).SpecialCells(xlCellTypeConstants).Copy
    .Cells(n + Model.Rows.Count + 1, "F").PasteSpecial xlPasteValues
    Drawing.Columns(2).SpecialCells(xlCellTypeConstants).Copy
    .Cells(n + Model.Rows.Count + 1, "Q").PasteSpecial xlPasteValues
  Else
    Drawing.Columns(1).Copy
    .Cells(n + Model.Rows.Count + 1, "F").PasteSpecial xlPasteValues
    Drawing.Columns(2).Copy
    .Cells(n + Model.Rows.Count + 1, "Q").PasteSpecial xlPasteValues
  End If
'your existing code

Upvotes: 3

Related Questions