Copy and Pasting without select vba

Question

am trying to make my code better, so the first thing I am trying to do is to remove all usage of selects and selection from my code.

The problem am facing is I am unable to get a stable code without using Selection. PFB code am using to make the selection

Sub findandCopyVisbleCellsinColumn(ByRef wb As Workbook, ByRef ws As Worksheet, ByRef columnNumber As Long)
    Dim lrow, lcolumn As Long
    With wb
        With ws
            
            ws.Activate                  
            Selection.End(xlToLeft).Select
            ws.Range(Cells(1, columnNumber).Address).Offset(1, 0).Select
            ws.Range(Selection, Selection.End(xlDown)).Select
            Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            
        End With
    End With
End Sub

PFB Code am using for calling above code and pasting the values

emptyCell = range_End_Method(wb, ws, 3)
Call findandCopyVisbleCellsinColumn(wb, ws1, 7)
ws.Range("C" & emptyCell).Offset(1, 0).PasteSpecial Paste:=xlPasteValues

What I have done until now

With ws

            ws.Activate
              
            Selection.End(xlToLeft).Select
            lrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            lcolumn = ws.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
            .Range(.Cells(.Cells(2, columnNumber).Address).Offset(1, 0), lrow, lcolumn).Copy
            
End With

this is giving an error for invalid property assignment. I suspect its due to assigning cells to cells, Please point me in the right direction.

Thanks in advance.

Answer 1

Hard to explain where you've gone wrong with your range selection.

.Range(.Cells(.Cells(2, columnNumber).Address).Offset(1, 0), lrow, lcolumn)

Range is one or more cells in the worksheet. Cells is a single cell in the worksheet - referenced using the row number and row column or letter. So Cells(1,1) will work, as will Cells(1,"A"). Your code has supplied a complete cell address - so is trying to do Cells("A1").

This is how I'd do it without selecting anything:

Sub Test()

    'Copy data from sheet1 to sheet2 in a different workbook.
    CopyAndPaste ThisWorkbook.Worksheets("Sheet1"), _
                 Workbooks("Book4").Worksheets("Sheet2")
                 
    'Copy data from sheet1 to sheet2 in workbook that contains this code.
    CopyAndPaste ThisWorkbook.Worksheets("Sheet1"), _
                 ThisWorkbook.Worksheets("Sheet2")

End Sub

Private Sub CopyAndPaste(Source As Worksheet, Target As Worksheet)

    Dim LastCell As Range
    Set LastCell = GetLastCell(Source)

    With Source
        'Copies a range from A1 to LastCell and pastes in Target cell A1.
        .Range(.Cells(1, 1), LastCell).Copy Destination:=Target.Cells(1, 1)
    End With

End Sub

Private Function GetLastCell(ws As Worksheet) As Range

    Dim lLastCol As Long, lLastRow As Long

    On Error Resume Next

    With ws
        lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row

        If lLastCol = 0 Then lLastCol = 1
        If lLastRow = 0 Then lLastRow = 1

        Set GetLastCell = .Cells(lLastRow, lLastCol)
    End With
    On Error GoTo 0

End Function

Note the actual copy/paste is a single line:
.Range(.Cells(1, 1), LastCell).Copy Destination:=Target.Cells(1, 1)

This copies the range on the Source worksheet from cells A1 (1,1) to whatever range is returned by the GetLastCell function. As that function returns a range object it can be used directly - no need to find the address and pass that separately to another range object.
The copied cells are then pasted to cell A1 on the Target worksheet. As long as you've got the correct sheet reference the code will know which workbook the worksheet belongs to - no need for With wb:With ws - the ws reference already contains the wb reference.

Answer 2

Copy Visible Cells in a Column

• The feedback to my post Function vs Sub(ByRef) was kind of groundbreaking to my understanding of the difference between ByVal and ByRef (and accidentally error handling, too). Basically, to your surprise, you will rarely need ByRef.

Option Explicit

Sub YourPBFCode()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.Worksheets("source")
    Dim dws As Worksheet: Set dws = wb.Worksheets("target")
    
    CopyVisibleCellsInColumn sws.Range("G2"), dws.Range("C2")
 
End Sub

' Just a test (example).
Sub CopyVisibleCellsInColumnTEST()

    Const sName As String = "Sheet1"
    Const sAddr As String = "A2"
    Const dName As String = "Sheet2"
    Const dAddr As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim sfCell As Range: Set sfCell = sws.Range(sAddr)
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim difCell As Range: Set difCell = dws.Range(dAddr)

    CopyVisibleCellsInColumn sfCell, difCell

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Copies the visible cells of a one-column range to another
'               one-column range. The source range is defined by its first cell
'               and the last cell in its column of its worksheet's used range.
'               The column of the destination range is defined by its first
'               initial cell. The first row of the destination range
'               will be the row of the last non-empty cell in the column
'               increased by one aka the first available row.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CopyVisibleCellsInColumn( _
        ByVal SourceFirstCell As Range, _
        ByVal DestinationInitialFirstCell As Range)
    If SourceFirstCell Is Nothing Then Exit Sub
    If DestinationInitialFirstCell Is Nothing Then Exit Sub
    
    ' Create a reference to the Source Range ('srg').
    Dim sfCell As Range: Set sfCell = SourceFirstCell.Cells(1)
    Dim srg As Range: Set srg = RefVisibleCellsinColumn(sfCell)
    If srg Is Nothing Then Exit Sub ' no data
    
    ' Create a reference to the Destination Range ('drg').
    Dim difCell As Range: Set difCell = DestinationInitialFirstCell.Cells(1)
    Dim dfCell As Range: Set dfCell = RefFirstAvailableCellInColumn(difCell)
    If dfCell Is Nothing Then Exit Sub ' no available cells
    Dim srCount As Long: srCount = srg.Cells.Count
    If srCount > dfCell.Worksheet.Rows.Count - dfCell.Row + 1 Then
        Exit Sub ' does not fit
    End If
    Dim drg As Range: Set drg = dfCell.Resize(srCount)
    
    ' Write values from the Source Range to the Destination Array ('dData').
    Dim dData As Variant: dData = GetColumnMultiRange(srg)
    
    ' Write values from the Destination Array to the Destination Range.
    drg.Value = dData
    
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the visible cells of the range
'               at the intersection of the one-column range from the first cell
'               of a range ('FirstCellRange') to the bottom-most worksheet cell,
'               and the used range of the worksheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefVisibleCellsinColumn( _
    ByVal FirstCellRange As Range) _
As Range
    If FirstCellRange Is Nothing Then Exit Function
    
    Dim fCell As Range: Set fCell = FirstCellRange.Cells(1)
    Dim wsrCount As Long: wsrCount = fCell.Worksheet.Rows.Count
    Dim crg As Range: Set crg = fCell.Resize(wsrCount - fCell.Row + 1)
    
    On Error Resume Next
    Set RefVisibleCellsinColumn = _
        Intersect(crg.Worksheet.UsedRange, crg).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      In the one-column range ('crg') from the first cell ('fCell')
'               of a range ('FirstCellRange') to the bottom-most worksheet cell,
'               creates a reference to the first available cell
'               i.e. the cell below the last non-empty cell ('lCell.Offset(1)').
'               If the one-column range ('crg') is empty,
'               the first cell ('fCell') is also the first available cell.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefFirstAvailableCellInColumn( _
    ByVal FirstCellRange As Range) _
As Range
    If FirstCellRange Is Nothing Then Exit Function
    
    Dim fCell As Range: Set fCell = FirstCellRange.Cells(1)
    Dim wsrCount As Long: wsrCount = fCell.Worksheet.Rows.Count
    Dim crg As Range: Set crg = fCell.Resize(wsrCount - fCell.Row + 1)
    Dim lCell As Range: Set lCell = crg.Find("*", , xlFormulas, , , xlPrevious)
    
    If lCell Is Nothing Then
        Set RefFirstAvailableCellInColumn = fCell
    Else
        If lCell.Row < wsrCount Then
            Set RefFirstAvailableCellInColumn = lCell.Offset(1)
        End If
    End If

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values of the first columns of each single range
'               of a multi-range in a 2D one-based one-column array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnMultiRange( _
    ByVal ColumnMultiRange As Range) _
As Variant
    On Error GoTo ClearError ' too many areas, "RTE '7': Out of memory"
    If ColumnMultiRange Is Nothing Then Exit Function
    
    Dim aCount As Long: aCount = ColumnMultiRange.Areas.Count
    Dim aData As Variant: ReDim aData(1 To aCount, 1 To 2)
    Dim ocData As Variant: ReDim ocData(1 To 1, 1 To 1)
    
    Dim arg As Range
    Dim a As Long
    Dim arCount As Long
    Dim drCount As Long
    For Each arg In ColumnMultiRange.Areas
        a = a + 1
        With arg.Columns(1)
            arCount = .Rows.Count
            If arCount = 1 Then ' one cell
                ocData(1, 1) = .Value
                aData(a, 1) = ocData
            Else ' multiple cells
                aData(a, 1) = .Value
            End If
        End With
        aData(a, 2) = arCount
        drCount = drCount + arCount
    Next arg
    'Debug.Print aCount, arCount, drCount
    
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To 1)
    
    Dim ar As Long
    Dim dr As Long
    For a = 1 To aCount
        For ar = 1 To aData(a, 2)
            dr = dr + 1
            dData(dr, 1) = aData(a, 1)(ar, 1)
        Next ar
    Next a

    GetColumnMultiRange = dData

ProcExit:
    Exit Function
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume ProcExit
End Function