使用Excel中的PasteSpecial跳过空白值VBA

Question

我试过了各种我在网上找到的解决方案，但没有运气。这里是我的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”变体，但那不是解决方案。任何帮助，将不胜感激。

Answer 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