Excel VBA在复制到另一个工作表时跳过空白

Question

我知道以前有人问过这个问题，我一直在阅读其他几个关于如何在将数据复制到另一个工作表时跳过空白行，但我似乎无法得到这些建议。

我的电子表格有一个表单，用户使用下拉菜单填写。然后，他们可以编辑表单上的数据以适合他们的特定项目，这可能包括删除数据，这将留下空白行。然后他们按下一个按钮，它就会把数据复制到另一张表上。

现在，代码复制数据，但是如果表单上有一个空白，它将在任务列表中创建一个空白行。我想让它停止，所以即使表单中有空白，当它将数据粘贴到任务列表时，它们都是一行一行的。

下面是我现在使用的代码:

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

任何帮助将是最感激的!

Answer 1

请替换这部分:

'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

'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