Copying and Pasting Data from one workbook to another without overwritting existing data

Question

I am having some issues with the code I have written below, object is of code is to copy data from columns A:E and G:U in one workbook to another without overwriting existing data.

File Path of source file is written in cell H13 and destination worksheet is written in cell H6, this is done because the source file and destination worksheet vary.

Sub Dataprep2() 

Application.ScreenUpdating = False     

Dim ws As String
Dim wb As Workbook
Dim cwb As String

Set wb = Workbooks.Open(Range("H13").Value) 

ws = ThisWorkbook.Sheets("Macro Control").Range("H6").Value

   ''' CODE ERRORS ON BELOW LINE ''' 

wb.Worksheets("MAL Corrections").Range("A:E").CopyDestination:=ThisWorkbook.Worksheets(ws).Range("A:E").End(xlUp).Row  

wb.Close True 

Application.ScreenUpdating = True

End Sub

You can't copy the *entire* column here... it won't fit into the destination sheet. `End(xlUp).Row` returns the row number, not a range. — BigBen, Jun 01 '20 at 16:57
So it's not possible to paste values from the source file after the existing values ? — Adam Robertson, Jun 01 '20 at 17:04
It is very possible, as long as you don't copy the *entire* column. [Find the last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba), and then only copy the cells with data. Imagine you copied the entire column A, and then tried to paste in A100 of the destination sheet. It won't fit; there's not enough cells. — BigBen, Jun 01 '20 at 17:05
You need to give the row number in this code `wb.Worksheets("MAL Corrections").Range("A:E")`. For example `wb.Worksheets("MAL Corrections").Range("A2", wb.Worksheets("MAL Corrections").range("E" * rows.count).end(xlup))` . And also for the destination, if for example it will always start in column A, then maybe you can try `ThisWorkbook.Worksheets(ws).Range("A" & rows.count).End(xlUp).offset(1,0)` — karma, Jun 01 '20 at 17:18

score 0 · Accepted Answer · answered Jun 01 '20 at 19:38

Complicating a Consolidation

Carefully adjust the values in the constants (first) section of the code in the Sub.
You only run the Sub.
The Functions are being called by the Sub.

The Code

Option Explicit

Sub Dataprep2()

    ' Source
    Const BookAddress As String = "H13"
    Const SourceName As String = "MAL Corrections"
    Const SourceFirstRow As Long = 2
    ' Target
    Const DataName As String = "Macro Control"
    Const TargetAddress As String = "H6"
    ' Source/Target
    Const STByColumn As Long = 1
    Dim STColumns As Variant
    STColumns = Array("A:E", "G:U")

    ' Define Data Worksheet.
    Dim wsD As Worksheet
    Set wsD = ThisWorkbook.Worksheets(DataName)
    ' Define Source Worksheet.
    Dim wbS As Workbook: Set wbS = Workbooks.Open(wsD.Range(BookAddress).Value)
    Dim wsS As Worksheet: Set wsS = wbS.Worksheets(SourceName)
    ' Define Target Worksheet
    Dim wsT As Worksheet
    Set wsT = ThisWorkbook.Worksheets(wsD.Range(TargetAddress).Value)

    ' Write values of ranges to arrays.
    Dim Source() As Variant, i As Long
    ReDim Source(UBound(STColumns))
    For i = 0 To UBound(Source)
        Source(i) = getColumns(wsS, STColumns(i), STByColumn, SourceFirstRow)
    Next i

    ' Calculate first empty row in target sheet.
    Dim TargetFirstRow As Long
    TargetFirstRow = getFirstEmptyRow(wsT, wsT.Columns(STByColumn).Column)
    If TargetFirstRow = 0 Then Exit Sub

    ' Write values of arrays to target sheet.
    Dim rng As Range
    For i = 0 To UBound(Source)
        Set rng = Intersect(wsT.Columns(STColumns(i)), wsT.Rows(TargetFirstRow))
        rng.Resize(UBound(Source(i)), UBound(Source(i), 2)).Value = Source(i)
    Next i

    wbS.Close False

End Sub

Function getColumns(Sheet As Worksheet, ByVal sourceColumns As String, _
                    Optional ByVal ByColumn As Long = 1, _
                    Optional ByVal FirstRow As Long = 1) As Variant
    Dim rng As Range, LastRow As Long
    Set rng = Sheet.Columns(sourceColumns)
    If ByColumn > rng.Columns.Count Then Exit Function
    Set rng = Sheet.Columns(sourceColumns).Columns(ByColumn) _
      .Find("*", , xlFormulas, , , xlPrevious)
    If rng Is Nothing Then Exit Function
    If rng.Row < FirstRow Then Exit Function
    getColumns = Intersect(Sheet.Columns(sourceColumns), Sheet.Rows(FirstRow)) _
                           .Resize(rng.Row - FirstRow + 1)
End Function

Function getFirstEmptyRow(Sheet As Worksheet, ByVal SourceColumn As Variant)
    Dim rng As Range
    Set rng = Sheet.Columns(SourceColumn) _
                           .Find("*", , xlFormulas, , , xlPrevious)
    If rng Is Nothing Then getFirstEmptyRow = 1: Exit Function
    If rng.Row = Sheet.Rows.Count Then Exit Function
    getFirstEmptyRow = rng.Row + 1
End Function

Thanks this works great!, quick question is there a way to get it to paste column G from the source into Column F on the destination workbook? — Adam Robertson, Jun 02 '20 at 16:15
@AdamRobertson: Close at the end of the code change to Set rng = Intersect(wsT.Columns(STColumns(i)), wsT.Rows(TargetFirstRow))`.Offset(, -i)`. — VBasic2008, Jun 02 '20 at 16:23

Copying and Pasting Data from one workbook to another without overwritting existing data

1 Answers1

Complicating a Consolidation