скопировать ячейку, если она содержит текст

Я думаю, это то, что вы ищете:

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:C20 в Sheet1 в C1 в Sheet2

Взято с здесь.

EDIT: Следующий ответ основан на вашем комментарии ________________________________________________________________________________

Если вы напишите что-то вроде ниже

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

Вы можете использовать массивы!

Вместо того, чтобы копировать информацию из одной ячейки в другую, вы можете сначала сохранить всю свою информацию в массиве, а затем распечатать массив на другом листе. Вы можете указать массиву избегать пустых ячеек. Как правило, использование массивов является лучшим способом хранения информации. (часто самый быстрый способ работы с информацией)

Если вы просматриваете только один столбец, вы можете использовать одномерный массив. Если вы просматриваете несколько столбцов и хотите напечатать информацию в соответствующем столбце (но в разных ячейках) на другой странице, вы можете использовать многомерный массив для хранения номера столбца/всего, что вы хотите.

Из вашего кода это может выглядеть так:

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