简体   繁体   中英

Excel VBA - choose workbook to copy from and paste into existing workbook on next blank row

I am new to VBA and have been using the site to piece together a solution.

I need to write a macro that prompts the user to open a file (wb2), copy a row of data from a Sheet1 in that workbook (wb2) and then paste it into the next empty row within the original workbook (wb) also on Sheet1. I got it to work up until I tried adding the code for pasting in the next empty row - I am now receiving the following error message, "Run-time error '438': Object doesn't support this property or method"

Any help would be greatly appreciated.

Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant

'Set source workbook
Set wb = ActiveWorkbook

'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

'Set selectedworkbook
Set wb2 = ActiveWorkbook

wb2.Range("A3:E3").Select
Selection.Copy
wb.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True

wb2.Close

'Set targetworkbook
Set wb = ActiveWorkbook

End Sub

Just a quick note on the subject: Instead of

wb2.Worksheets("Output").Range("J3:R3").Select
Selection.Copy

try

wb2.Worksheets("Output").Range("J3:R3").Copy

Also Instead of

wb.Worksheets("Master").Range("C" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

try

wb.Worksheets("Master").Range("C" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Often times, Select creates unexplainable errors. Particularly when working with multiple workbooks, try to stay away from Select . This code comes almost directly from working code I have. Let us know if this doesn't fix the problem.

I re-worked the code and got it working. It's probably not the cleanest way to do it, but given my timeline and lack of VBA knowledge, it will have to do.

Many thanks to engineersmnky for their help.

Description: This code should be put into the worksheet you want to paste content into from another workbook. When it runs it will prompt you to open a workbook to copy from ("Output" worksheet), it will then select the cells you specify in the code (JR:R3), paste them in starting at the next empty row of your initial workbook (finding the last row in column C in the "Master" worksheet), and then it will close & save the workbook you just copied from.

Sub CommandButton1_Click()

'Last cell in column
Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long

Set WS = Worksheets("Master")
With WS
    Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With

Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant

'Set source workbook
Set wb = ActiveWorkbook

'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

'Set selectedworkbook
Set wb2 = ActiveWorkbook

'Select cells to copy
wb2.Worksheets("Output").Range("J3:R3").Select
Selection.Copy

'Go back to original workbook you want to paste into
wb.Activate

'Paste starting at the last empty row
wb.Worksheets("Master").Range("C" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True

'Close and save the workbook you copied from
wb2.Save
wb2.Close

End Sub

Have you tried this

Selection.Copy
wb.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial xlPasteValues

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM