在 Excel VBA 中使用 PasteSpecial 跳过空白值答案

【问题标题】：Skip Blank Values With PasteSpecial in Excel VBA在 Excel VBA 中使用 PasteSpecial 跳过空白值
【发布时间】：2017-05-25 16:25:51
【问题描述】：

我尝试了各种在网上找到的解决方案，但都没有成功。这是我的 VBA 代码，用于从大约 30 张纸上复制单元格并将它们全部粘贴到一张纸上。每个工作表都有 4 列中的公式，如果另一个工作表中有值，则显示一个值。像这样：

=IF(Sheet1!A2<>"", Sheet1!A2, "")

然后我在我希望它输出的页面上运行我的宏：

Sub SummurizeSheets()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets("Summary").Activate

For Each ws In Worksheets
    If ws.Name <> "Summary" And ws.Name <> "Sheet1" Then
        ws.Range("A2:D5406").Copy
        Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues), SkipBlanks:=True
    End If
Next ws
End Sub

输出结果是在包含实际值的单元格之后有很多空白单元格。

我尝试将“SkipBlanks”变体放在那里，但这不是解决方案。任何帮助将不胜感激。

【问题讨论】：

标签： excel vba

【解决方案1】：

这是在 excelforum.com 上为我解答的，我想我会在这里发布解决方案，以防它帮助其他人。

Sub SummurizeSheets()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets("Summary").Activate

For Each ws In Worksheets
    If ws.Name <> "Summary" And ws.Name <> "Sheet1" Then
        ws.Range("A2:D5406").Copy
        Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=False
    End If
Next ws

'Try inserting this line
'***********************************************************************

Worksheets("Summary").Select

'************************************************************************
'Find the last used row in column 1
LR = Cells(Rows.Count, 1).End(xlUp).Row

'Insert a formula in column E to return the row number of any non blank row
Range("E1:E" & LR).FormulaR1C1 = "=IF(RC[-4]="""","""",ROW())"

'Copy Paste Values to remove the formula
Range("E1:E" & LR).Value = Range("E1:E" & LR).Value

'Sort your data
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add Key:=Range("E1:E" & LR) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Summary").Sort
    .SetRange Range("A1:E" & LR)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Clear Column E
Range("E1:E" & LR).ClearContents
Range("A1").Select
End Sub

【讨论】：