将表粘贴到不同的excel实例中

时间:2016-04-27 11:25:15

标签: vba excel-vba excel

我正在尝试创建一个宏,将所选范围从一个excel实例粘贴到另一个excel实例中。

现在我面临两个问题。

第一个问题是我无法自动将范围粘贴到与选择范围相同的地址上(尽管在不同的工作表上)。

第二个问题是我设法粘贴了值,但是如果我实际上尝试复制一个表格,它会被粘贴为图片。

我也不确定我的代码是否非常有效,这些只是我从互联网上复制的零碎内容。

提前感谢您的帮助。

Private Sub CommandButton1_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim ws As Workbook
Dim rng As Range, dst As Range
Dim vals() As Variant
Dim xlSht

Set ws = ThisWorkbook

'select second file
fpath = Application.GetOpenFilename(, , Title:="Please select a file")
If fpath = False Then
 ' They pressed Cancel

    MsgBox "Stopping because you did not select a file"

    Exit Sub

Else

    Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Open(fpath)
    xlApp.Visible = True

End If
ws.Sheets(2).Select


Set rng = Application.InputBox(Prompt:="Please Select Range",         Title:="Range Select", Type:=8)

Set xlSht = xlApp.Sheets(1)

xlSht.Range("A1").Select

Set dst = xlApp.InputBox(Prompt:="Please Select Range", Title:="Range     
Select", Type:=8)




rng.Copy
dst.PasteSpecial xlPasteAll

'vals = rng
'dst.Value = vals

End Sub

1 个答案:

答案 0 :(得分:0)

似乎excel不能直接粘贴到另一个实例,而是必须使用windows粘贴功能。我想这就是为什么你的PasteSpecial粘贴你的范围的照片。如果你使用PasteSpecial xlPasteValues它似乎工作,但更好的方法是在同一个实例中打开第二个工作簿(消除xlApp):

'...
fpath = Application.GetOpenFilename(, , Title:="Please select a file")
'...
Set xlBook = Application.Workbooks.Open(fpath)

ws.activate  'wb might be a better name
set rng = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)

Set xlSht = xlBook.Sheets(1)
xlSht.Activate

set dst = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)

rng.Copy
dst.PasteSpecial xlPasteAll

如果您要粘贴到与rng相同的位置,则可以使用

Set dst = xlSht.Cells(rng.Row,rng.Column)

但可能有更好的方式