使用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