複製一系列單元格並僅選擇包含數據的單元格

Question

我正在尋找一種方法來複制一系列單元格，但僅複製包含值的單元格。

在我的Excel表中，我有從A1-A18運行的數據，B是空的，C1-C2。現在我想複製所有包含值的單元格。

With Range("A1") 
    Range(.Cells(1, 1), .End(xlDown).Cells(50, 3)).Copy 
End With 

這會從A1-C50複製的一切，但我只想A1-A18和C1-C2將要複印視爲儘管這些包含數據。但是它需要以一種方式形成，一旦我在B中有數據或者我的範圍擴展了，那麼它們也會被複制。

'So the range could be 5000 and it only selects the data with a value. 
With Range("A1") 
Range(.Cells(1, 1), .End(xlDown).Cells(5000, 3)).Copy 
End With 

謝謝！

---

感謝Jean，當前代碼：

Sub test() 

Dim i As Integer 
Sheets("Sheet1").Select 
i = 1 

With Range("A1") 
    If .Cells(1, 1).Value = "" Then 
    Else 
    Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("A" & i) 
    x = x + 1 
    End If 
End With 

Sheets("Sheet1").Select 

x = 1 
With Range("B1") 
' Column B may be empty. If so, xlDown will return cell C65536 
' and whole empty column will be copied... prevent this. 
    If .Cells(1, 1).Value = "" Then 
     'Nothing in this column. 
     'Do nothing. 
    Else 
     Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("B" & i) 
     x = x + 1 
    End If 
End With 

Sheets("Sheet1").Select 

x = 1 
With Range("C1") 
    If .Cells(1, 1).Value = "" Then 
    Else 
     Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("C" & i) 
     x = x + 1 
    End If 
End With 

End Sub 

A1 - A5包含數據，A6是相思，A7包含數據。它在A6停下來並轉向B列，並以相同的方式繼續。

Answer 1

由於您的三列有不同的大小，最安全的做法是逐個複製它們。 PasteSpecial的任何快捷方式都可能最終導致您頭痛。

With Range("A1") 
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeA 
End With 

With Range("B1") 
    ' Column B may be empty. If so, xlDown will return cell C65536 
    ' and whole empty column will be copied... prevent this. 
    If .Cells(1, 1).Value = "" Then 
     'Nothing in this column. 
     'Do nothing. 
    Else 
     Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeB 
    EndIf 
End With 

With Range("C1") 
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeC 
End With 

現在這是醜陋的，和更清潔的選擇是遍歷列，特別是如果你有很多欄目，你就以相同的順序將其粘貼到相鄰列。

Sub CopyStuff() 

    Dim iCol As Long 

    ' Loop through columns 
    For iCol = 1 To 3 ' or however many columns you have 
     With Worksheets("Sheet1").Columns(iCol) 
      ' Check that column is not empty. 
      If .Cells(1, 1).Value = "" Then 
       'Nothing in this column. 
       'Do nothing. 
      Else 
       ' Copy the column to the destination 
       Range(.Cells(1, 1), .End(xlDown)).Copy _ 
        Destination:=Worksheets("Sheet2").Columns(iCol).Cells(1, 1) 
      End If 
     End With 
    Next iCol 

End Sub 

---

編輯 那麼，你改變你的問題......試圖通過單個細胞循環，檢查當前單元格是空的，如果不是複製。沒有測試過這一點，但你的想法：

iMaxRow = 5000 ' or whatever the max is. 
    'Don't make too large because this will slow down your code. 

    ' Loop through columns and rows 
    For iCol = 1 To 3 ' or however many columns you have 
     For iRow = 1 To iMaxRow 

     With Worksheets("Sheet1").Cells(iRow,iCol) 
      ' Check that cell is not empty. 
      If .Value = "" Then 
       'Nothing in this cell. 
       'Do nothing. 
      Else 
       ' Copy the cell to the destination 
       .Copy Destination:=Worksheets("Sheet2").cells(iRow,iCol) 
      End If 
     End With 

     Next iRow 
    Next iCol 

該代碼就會在iMaxRow很大很慢。我的直覺是你試圖以某種低效率的方式解決問題......當問題不斷變化時，要解決最佳策略有點困難。

Answer 2

看看貼的特殊功能。有一個'空白'屬性可以幫助你。

Answer 3

要改善Jean-Francois Corbett的回答，請使用.UsedRange.Rows.Count獲取上次使用的行。這會給你一個相當準確的範圍，它不會停在第一個空白單元格。

這裏是一個鏈接到一個很好的例子，適合初學者評論筆記...

• Excel macro - paste only non empty cells from one sheet to another - Stack Overflow