複製單元格，如果它包含文本

Question

數據從網絡表單傳輸到Excel。並非每個細胞都能接受輸入有很多單元格，掃描每個單元格尋找文本是非常耗時的。

如何獲取從sheet1自動複製到sheet2的文本。但我不希望單元格顯示在與原始表單相同的佈局中。我希望將它們組合在一起，消除它們之間的所有空單元。我還想從包含文本的行中抓取標題。

我發現這個宏：

Sub CopyC() 
Dim SrchRng As Range, cel As Range 
Set SrchRng = Range("C1:C10") 
For Each cel In SrchRng 
    If cel.Value <> "" Then 
     cel.Offset(2, 1).Value = cel.Value 
    End If 
Next cel 

它吸引只包含文本的單元格，但它顯示在完全相同的佈局，它發現它在任何幫助，將不勝感激，節省了我很多在未來的時間進行掃描，在此先感謝:)

Answer 1

我想這是你在找什麼：

Sub CopyNonBlankCells() 
    Dim cel As Range, myRange As Range, CopyRange As Range 

    Set myRange = Sheet1.Range("C1:C20") '---> give your range here 

    For Each cel In myRange 
     If Not IsEmpty(cel) Then 
      If CopyRange Is Nothing Then 
       Set CopyRange = cel 
      Else 
       Set CopyRange = Union(CopyRange, cel) 
      End If 
     End If 
    Next cel 

    CopyRange.Copy Sheet2.Range("C1") '---> enter desired range to paste copied range without blank cells 
End Sub 

上面的代碼將在複製範圍到C1在Sheet2

從here得到這個。

編輯：以下的答案是基於您的評論 ________________________________________________________________________________

如果你會寫類似下面

Set myRange = Sheet1.Range("G:G") 
Set myRange = Sheet2.Range("G:G") 

myRange將是第一套Sheet1.Range("G:G")再到Sheet2.Range("G:G")這意味着電流範圍myRange將有Sheet2.Range("G:G")。

如果您想使用多個範圍，您可以使用UNION函數，但有一個侷限性，即使用UNION，您可以將不同的範圍組合到一個工作表中。而您的要求是結合不同工作表的範圍。爲了做到這一點，我添加了一個新的工作表，並將所有工作表中的G:G範圍添加到它中。然後在使用新添加的表格後，我將其刪除。

以下代碼將在名爲Result的表中爲您提供所需的輸出。

Sub CopyNonBlankCells() 
    Dim cel As Range, myRange As Range, CopyRange As Range 

    Dim wsCount As Integer, i As Integer 
    Dim lastRow As Long, lastRowTemp As Long 
    Dim tempSheet As Worksheet 

    wsCount = Worksheets.Count '--->wsCount will give the number of Sheets in your workbook 

    Set tempSheet = Worksheets.Add '--->new sheet added 
    tempSheet.Move After:=Worksheets(wsCount + 1) 

    For i = 1 To wsCount 
     If Sheets(i).Name <> "Result" Then '---> not considering sheet "Result" for taking data 
      lastRow = Sheets(i).Cells(Rows.Count, "G").End(xlUp).Row '--->will give last row in sheet 
      lastRowTemp = tempSheet.Cells(Rows.Count, "G").End(xlUp).Row '--->will give last row in newly added sheet 
      Sheets(i).Range("G1:G" & lastRow).Copy _ 
      tempSheet.Range("G" & lastRowTemp + 1).End(xlUp)(2) 
     End If 
    Next i 

    lastRowTemp = tempSheet.Cells(Rows.Count, "G").End(xlUp).Row 
    Set myRange = tempSheet.Range("G1:G" & lastRowTemp) '--->setting range for removing blanks cells 

    For Each cel In myRange 
     If Not IsEmpty(cel) Then 
      If CopyRange Is Nothing Then 
       Set CopyRange = cel 
      Else 
       Set CopyRange = Union(CopyRange, cel) 
      End If 
     End If 
    Next cel 

    CopyRange.Copy Sheets("Result").Range("G1") '---> enter desired range to paste copied range without blank cells 

    Application.DisplayAlerts = False 
    tempSheet.Delete  '--->deleting added sheet 
    Application.DisplayAlerts = True 
End Sub 

Answer 2

您可以使用數組！

不是將信息從一個單元複製到另一個單元，而是先將所有信息存儲在數組中，然後將數組打印到另一個表上。您可以告訴數組以避免空單元格。通常，使用數組是存儲信息的最佳方式。 （通常是使用信息的最快方式）

如果您只查看一列，則可以使用一維數組。如果您正在查看多個列，並且希望將信息打印到另一頁中的相應列（但是不同的單元格），則可以使用多維數組來存儲列號/您想要的任何其他內容。

從你的代碼，它可能是這樣的：

Sub CopyC() 
Dim SrchRng As Range, cel As Range 

'Declare your 1-d array (I don't know what you are storing) 
Dim myarray() as variant 
Dim n as integer 
Dim i as integer 

Set SrchRng = Range("C1:C10") 
'define the number of elements in the array - 1 for now, increase it as we go 
n = 0 
Redim myarray(0 to n) 

For Each cel In SrchRng 
    If cel.Value <> "" Then 
     'redim preserve stores the previous values in the array as you redimension it 
     Redim Preserve myarray(0 to n) 
     myarray(n) = cel.Value 
     'increase n by 1 so next time the array will be 1 larger 
     n = n + 1 
    End If 
Next cel 

'information is now stored, print it out in a loop 
'this will print it out in sheet 2 providing it is called "Sheet2" 
For i = 0 to ubound(myarray) 
    Sheets("Sheet2").cells(i,1).value = myarray(i) 
Next i