» Copy a Column or Columns to a Database sheet using VBA in Microsoft Excel

VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel

• The example codes will copy to a database sheet with the name Sheet2.
• Every time you run one of the subs the cells will be placed below the last row with data or after the last Column with data in sheet2.
• For each example there is a macro that does a normal copy and one that is only Copy the Values.
• The Example subs use the functions below (the macros won’t work without the functions).

Remember there are only 256 columns in Excel

Sub CopyColumn()
    Dim sourceRange As Range
    Dim destrange As Range
    Dim Lc As Integer
    Lc = Lastcol(Sheets("Sheet2")) + 1
    Set sourceRange = Sheets("Sheet1").Columns("A:A")
    Set destrange = Sheets("Sheet2").Columns(Lc)
    sourceRange.Copy destrange
End Sub

Sub CopyColumnValues()
    Dim sourceRange As Range
    Dim destrange As Range
    Dim Lc As Integer
    Lc = Lastcol(Sheets("Sheet2")) + 1
    Set sourceRange = Sheets("Sheet1").Columns("A:A")
    Set destrange = Sheets("Sheet2").Columns(Lc). _
                    Resize(, sourceRange.Columns.Count)
    destrange.Value = sourceRange.Value
End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function Lastcol(sh As Worksheet)
    On Error Resume Next
    Lastcol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function