Question

我正在尝试在工作簿和工作表之间复制和粘贴数据。我有以下代码，但似乎占用了很多时间。我想知道复制是否有更简单的方法？

    Sub Test1()

    Dim wb As Workbook, x As String, y As String, wb1 As Workbook

    For Each wb In Application.Workbooks
    If wb.Name <> ThisWorkbook.Name Then x = wb.Name
    Next wb

    Workbooks(x).Activate

    Sheets("Sheet1").Range("A:E").Copy

    ActiveWindow.WindowState = xlMinimized

    Sheets("Sheet1").Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll
    Sheets("Sheet1").Range("A1").Select

    Workbooks(x).Activate
    ActiveWindow.WindowState = xlNormal
    Sheets("Sheet1").Range("F:F").Copy
    ActiveWindow.WindowState = xlMinimized
    Sheets("Sheet1").Range("G:G").Select
    Selection.PasteSpecial Paste:=xlPasteAll
    Workbooks(x).Activate
    ActiveWindow.WindowState = xlNormal

    End Sub

Answer 1

一些单挑： - 使用

Sub Test1()
Application.Screenupdating = False
'yourcode
Application.Screenupdating = True
End Sub

在你的代码中更快地执行它

用于复制粘贴可以使用的短版本

Sheets("Sheet1").Range("F:F").Copy Sheets("Sheet1").Range("G:G")

不要激活某些书籍，而是尝试直接粘贴到目的地，如上面的代码中所述。

你可以删除“ActiveWindow.WindowState = xlMinimized”

编辑： - 根据添加的评论

dim wb1 as workbook
dim wb2 as workbook
set wb1 = ("Filename.xlsx")
set wb2 = ("filename.xlsx")

wb1.sheetname.range("A1").copy wb2.sheetname.range("A1")

您还可以进一步转换您的工作表名称

dim ws as worksheet
set ws = worksheets("Sheetname")

按秒编辑注释（将变量添加到新打开的工作簿）

Dim path as variant
dim wsb as workbook

path = \\C:your path   ' not the sheet name
Set wsb = Workbooks.Open(filename:=myfolder & "\" & "filename".xlsm")
'your codes

Answer 2

我从JMAX得到了一些想法，并找到了一种方法如下：

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,*.xls", _
    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 targetworkbook
Set wb2 = ActiveWorkbook

'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet1").Range("A:B").Copy
wb.Worksheets("Sheet1").Activate
wb.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteAll
End Sub

在工作簿和工作表之间复制

2 个答案: