Forum Discussion

yprasto's avatar
yprasto
Copper Contributor
Jun 28, 2021

copy paste & transpose from one workbook to other without replacing existing data

Dear Friends

 

I'm newbie in excel VBA script. i'm making a script that :

1. Copy data from one sheet of workbook to another sheet of work book

2. Paste the data and transpose the data ( from column to row)

3. i can copy data from multiple sheet of workbook  and paste to the same sheet of work book

i have tried making a script, but everytime it paste new workbook, it replace the existing data. my wish is to not replace and add the data to the next empty row . Here is the script, i wish someone could help to take a look and advice the error. many thanks in advance and appreciate the help

 

Dim filter As String, caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetSheet As Worksheet, sourceSheet As Worksheet

Set targetSheet = ActiveWorkbook.Worksheets("PK")

filter = "Excel and CSV Files (*.xls;*.xlsx;*.csv),*.xls;*.xlsx;*.csv"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set sourceSheet = customerWorkbook.Worksheets("1210000")

sourceSheet.Range("B4:c257").Copy
targetSheet.Range("C1").PasteSpecial Transpose:=True
customerWorkbook.Close

End Sub

Macros and VBA

1 Reply

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jun 28, 2021

    yprasto 

    Try this version:

    Sub Test()
    Dim filter As String, caption As String
    Dim customerFilename As String
    Dim customerWorkbook As Workbook
    Dim targetSheet As Worksheet, sourceSheet As Worksheet
    Dim NextRow As Long

    filter = "Excel and CSV Files (*.xls;*.xlsx;*.csv),*.xls;*.xlsx;*.csv"
    caption = "Please Select an input file "
    customerFilename = Application.GetOpenFilename(filter, , caption)
    If customerFilename = "False" Then
        Beep
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Set customerWorkbook = Application.Workbooks.Open(customerFilename)
    Set sourceSheet = customerWorkbook.Worksheets("1210000")
    Set targetSheet = ActiveWorkbook.Worksheets("PK")
    NextRow = targetSheet.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    sourceSheet.Range("B4:C257").Copy
    targetSheet.Range("C" & NextRow).PasteSpecial Transpose:=True
    customerWorkbook.Close SaveChanges:=False

    Application.ScreenUpdating = True
End Sub

Resources