Share via

VBA code to transfer data from one table to another without writing over the data that is already in the destination table?

Anonymous
2023-06-22T05:02:49+00:00

I have two tables the first table is on Sheet 1 with a range of A5:Y130. The second table is on Sheet 2 with the same range. I want to write a VBA that will transfer the data from table 1 and put it into table 2 below any existing data in table two. Can someone please get me started with a Code for this?

Microsoft 365 and Office | Excel | For business | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

2 answers

Sort by: Most helpful
Most helpful Newest Oldest
  1. Anonymous
    2023-06-22T10:27:36+00:00

    Hi,

    try this code

    [Update-2]

    Sub Append_Data_ValuesFormats() '<< START VBA

    ' ## 22-06-2023 ##

    Const colStart$ = "A" 'First column in both sheets / change as needed

    Const colEnd$ = "Y" 'Last column in both sheets / change as needed

    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Sheets("Sheet1") '<< source sheet name / change as needed

    Set ws2 = Sheets("Sheet2") '<< target sheet name / change as needed

    Dim rng As Range

    Dim N1, N2, c, v, x

    N1 = 5 '<< headers in row5, in source sht / change as needed

    N2 = 5 '<< headers in row5, in target sht / change as needed

    Dim L1, L2

    L1 = ws1.Cells(Rows.Count, colStart).End(xlUp).Row

    L2 = ws2.Cells(Rows.Count, colStart).End(xlUp).Row

    Application.ScreenUpdating = False

    ws1.Range(ws1.Cells(N1 + 1, colStart), ws1.Cells(L1, colEnd)).SpecialCells(xlCellTypeVisible).Copy

    ws2.Cells(L2 + 1, colStart).PasteSpecial xlFormats

    ws2.Cells(L2 + 1, colStart).PasteSpecial xlValues

    Application.CutCopyMode = False

    L2 = ws2.Cells(Rows.Count, colStart).End(xlUp).Row

    c = ws2.Range(ws2.Cells(1, colStart), ws2.Cells(1, colEnd)).Columns.Count

    ReDim v(0 To c - 1)

    For x = 0 To c - 1

    v(x) = x + 1

    Next x

    Set rng = ws2.Range(ws2.Cells(N2, colStart), ws2.Cells(L2, colEnd))

    rng.RemoveDuplicates Columns:=(v), Header:=xlYes

    Application.ScreenUpdating = True

    End Sub'<< END VBA

    ======================================

    sample

    1. before run the code

    data in source sheet

    data in target sht

    1. after run the code

    result in target sht

    Was this answer helpful?

    1 person found this answer helpful.
    0 comments
  2. Deleted

    This answer has been deleted due to a violation of our Code of Conduct. The answer was manually reported or identified through automated detection before action was taken. Please refer to our Code of Conduct for more information.

    Comments have been turned off. Learn more