0

I am trying to copy data from one worksheet to another based on the column-name. In the source worksheet, the data starts at A1. In the destination worksheet, the data should be pasted at row A11 and not A1. If I used EntireColumn.Copy I get an error about the source and destination copy area not being the same. I came across the UsedRange property but I am unbale to apply it to my scenario

    For Each columnName In allColumns
    'call a function to get the column to copy 
    If columnToCopy > 0 Then
        columnName.Offset(1, 0).EntireColumn.Copy Destination:=ws2.Cells(11, columnToCopy)
    End If
Next

In the above snippet, In dont want to use 'EntireColumn'. I only want the columns that have data. The variable columnName is for example 'Person ID'

What is the best way to do this?

Thanks.

aynber
  • 22,380
  • 8
  • 50
  • 63
  • 1
    Probably the best way is to [find the last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba). – BigBen Oct 30 '20 at 20:12
  • Thanks. I did try that but I was unable to integrate it with my columnName variable. How would I be able to do that? – user14551205 Oct 30 '20 at 20:23
  • 1
    You could potentially use [`Range.Resize`](https://learn.microsoft.com/en-us/office/vba/api/excel.range.resize). – BigBen Oct 30 '20 at 20:37

2 Answers2

1

This would be a typical approach:

    For Each ColumnName In allColumns
        If columnToCopy > 0 Then
            With ColumnName.Parent
                .Range(ColumnName.Offset(1, 0), .Cells(.Rows.Count, ColumnName.Column).End(xlUp)).Copy _
                              Destination:=ws2.Cells(11, columnToCopy)
            End With
        End If
    Next

Assumes allColumns is a collection of single-cell ranges/column headers.

Tim Williams
  • 154,628
  • 8
  • 97
  • 125
0

Copy/Paste Column

There is not enough information to give an accurate answer so here is a scenario you might consider studying.

The Code

Option Explicit

Sub TESTdetermineColumnNumber()
    
    ' Define constants. Should be more.

    ' Define Criteria.
    Const Criteria As String = "Total"
    ' Define Header Row.
    Const hRow As Long = 1

    ' Define Copy Range (Column Range)

    ' Define Source Worksheet.
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' Define Header Row Range.
    Dim RowRange As Range
    Set RowRange = ws.Rows(hRow)
    ' Determine Column Number.
    Dim ColumnNumber As Long
    ColumnNumber = determineColumnNumber(RowRange, Criteria)
    ' Validate Column Number.
    If ColumnNumber = 0 Then
        Exit Sub
    End If
    ' Determine Last Row.
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, ColumnNumber).End(xlUp).Row
    ' Define First Data Row Number.
    Dim FirstRow As Long
    FirstRow = hRow + 1
    ' Define Column Range.
    Dim ColumnRange As Range
    Set ColumnRange = ws.Cells(FirstRow, ColumnNumber) _
                        .Resize(LastRow - FirstRow + 1)

    ' Define Paste Range.

    ' Define Destination Worksheet.
    Dim ws2 As Worksheet
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    ' Define Destination Column.
    Dim columnToCopy As Long
    columnToCopy = 2
    ' Define Paste Range.
    Dim PasteRange As Range
    Set PasteRange = ws2.Cells(11, columnToCopy)

    ' Copy/Paste.

    ' Copy values, formulas and formats.
    ColumnRange.Copy Destination:=PasteRange
    ' It is more efficient if you need only values to use the following:
    PasteRange.Resize(ColumnRange.Rows.Count).Value = ColumnRange.Value
    
End Sub

Function determineColumnNumber(RowRange As Range, _
                               Criteria As String) _
         As Long
    Dim Temp As Variant
    Temp = Application.Match(Criteria, RowRange, 0)
    If Not IsError(Temp) Then
        determineColumnNumber = Temp
    End If
End Function
VBasic2008
  • 44,888
  • 5
  • 17
  • 28