复制单元格，如果它包含文本

Question

Data is transferred from a web-form to Excel. Not every cell receives inputs. There are many cells, it is time consuming to scan each cell looking for text.

How do I get the text automatically copied from sheet1 to sheet2. But I don't want the cells displayed in the same layout as the original sheet. I would like them to be grouped together, eliminating all of the empty cells in between. I would also like to grab the title from the row that contains the text.

I found this macro:

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

It grabs only cells that contain text, but it displays it in the exact same layout that it found it in. Any help would be appreciated and save me a lot of scan time in the future, thanks in advance :)

Answer 1

I guess this is what you are looking for:

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

Above code will copy range C1:C20 in Sheet1 to C1 in Sheet2

Got this from here .

EDIT : Following answer is based on your comment ________________________________________________________________________________

If you'll write something like below

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

myRange will be first set to Sheet1.Range("G:G") and then to Sheet2.Range("G:G") that means current range that myRange will have is Sheet2.Range("G:G") .

If you want to use multiple ranges you can go for UNION function but there's a limitation that using UNION, you can combine different ranges but of only one sheet. And your requirement is to combine ranges from different sheets. To accomplish that I am adding a new worksheet and adding your G:G ranges from all the sheets to it. Then after using newly added sheet I am deleting it.

Following code will give you the desired output in the sheet named 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

You can use arrays!

Instead of copying information from one cell to another, you can store all your information in an array first, then print the array on another sheet. You can tell the array to avoid empty cells. Typically, using arrays is the best way to store information. (Often the fastest way to work with info)

If you are only looking at one column, you could use a one-dimensional array. If you are looking at multiple columns, and want to print the information into the corresponding column (but different cells) in another page then you could a multi-dimensional array to store column number/anything else you wanted.

From your code, it could look like this:

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