Question

试图创建一个按钮，打开一个对话框，让用户选择一个文件，然后将数据从所选文件复制到当前工作簿中。我能够打开对话框并选择一个文件，但是我收到一条错误消息，指出“Range 类的 PastSpecial 方法失败”。此外，我试图将其粘贴到现有列表中，但我还没有弄清楚。任何人都知道如何修复此错误并将其添加到现有列表中？

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
     
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A4:R1000").Copy
        ThisWorkbook.Worksheets(3).Range("A2").PasteSpecial xlPastValues
        OpenBook.Close False
    End If
    
End Sub

Answer 1

从另一个工作簿复制范围

常见步骤

开源工作簿 (Openbook)。
定义（创建引用）源范围 (srg)。
定义（创建对）目标第一个单元格 (dCell) 的引用。

使用Resize按赋值复制：

dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value

关闭源工作簿 (Openbook)。

代码

Option Explicit

Sub Get_Data_From_File()
     
    ' Pick Source File.
    Dim FileToOpen As Variant
    FileToOpen = Application.GetOpenFilename( _
        Title:="Browse for your File & Import Range", _
        FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Application.ScreenUpdating = False
        ' Open Source Workbook (File).
        Dim OpenBook As Workbook: Set OpenBook = Workbooks.Open(FileToOpen)
        ' Define Source Range.
        Dim srg As Range: Set srg = OpenBook.Sheets(1).Range("A4:R1000")
        With ThisWorkbook.Sheets(3).Range("A2")
            ' Define Destination First (available) Cell.
            Dim dCell As Range
            Set dCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
                .Find("*", , xlFormulas, , , xlPrevious)
            If dCell Is Nothing Then
                Set dCell = .Offset ' "A2" is the first available cell.
            Else
                Set dCell = dCell.Offset(1)
            End If
            ' Copy by assignement.
            dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
            '.Worksheet.Parent.Save ' Save Destination Workbook.
        End With
        ' Close Destination Workbook.
        OpenBook.Close SaveChanges:=False
        Application.ScreenUpdating = True
        'MsgBox "Range copied."
    Else
        'MsgBox "Cancelled."
    End If
    
End Sub

从一个工作簿复制/粘贴到另一个

1 个答案:

从另一个工作簿复制范围