2013-12-16 19 views
1

Я новичок в VBA и использую сайт для сборки решения.Excel VBA - выберите книгу для копирования и вставки в существующую книгу в следующей пустой строке

Мне нужно написать макрос, предлагающий пользователю открыть файл (wb2), скопировать строку данных из листа 1 в эту книгу (wb2), а затем вставить ее в следующую пустую строку в исходной книге (wb) также на Sheet1. Я получил его для работы до тех пор, пока не попытаюсь добавить код для вставки в следующую пустую строку. Теперь я получаю следующее сообщение об ошибке «Ошибка времени выполнения» 438: Объект не поддерживает это свойство или метод »

Любая помощь будет принята с благодарностью.

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 

ответ

0

Вы пробовали это

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

Благодарим за быстрый ответ. Я просто попробовал ваше обновление, но я все еще получаю ту же ошибку: «Ошибка времени выполнения 438»: объект не поддерживает это свойство или метод ». – user3108483

+0

попробуйте цепочку 1 за раз, чтобы увидеть, где ошибка, потому что это может быть wb не поддерживает '.Cells', так как это метод рабочей таблицы. – engineersmnky

+0

Хорошая идея. Я прошел через это, как вы предлагали, и ошибка возникает, когда она попадает в кусок «.Cells». – user3108483

2

I переработанный код и получил это работает. Это, вероятно, не самый чистый способ сделать это, но, учитывая мой график и отсутствие знаний VBA, это должно будет сделать.

Большое спасибо инженерам за их помощь.

Описание: Этот код должен быть помещен в рабочий лист, в который вы хотите вставить контент из другой книги. Когда он запустится, вы предложите открыть книгу для копирования (рабочий лист «Выход»), затем выберете ячейки, которые вы указываете в коде (JR: R3), вставьте их, начиная с следующей пустой строки вашего начального (найти последнюю строку в столбце C на листе «Мастер»), а затем она закроется. & сохраните книгу, с которой вы только что скопировали.

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 
6

Только быстрое примечание по теме: Вместо

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

попробовать

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

Также Вместо

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

попробовать

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

Часто, Select создает необъяснимые ошибки. В частности, при работе с несколькими книгами старайтесь держаться подальше от Select. Этот код поступает почти непосредственно из рабочего кода, который у меня есть. Сообщите нам, если это не устранит проблему.

Смежные вопросы