首页 > 解决方案 > 打开工作簿并在两个工作簿中复制具有可变范围的数据

问题描述

我正在设置这张表格,我将在其中使用 VBA 打开另一个文件,复制它的内容并将它们粘贴到我的主文件中。问题是:我从中复制信息的文件和我粘贴信息的文件都有可变范围。到目前为止,这是我的代码:

Sub Import_Data()
Dim FiletoOpen As Variant
Dim lastrowopen As Variant
Dim lastrowthis As Variant

FiletoOpen = Application.GetOpenFilename

If FiletoOpen <> False Then
Set Openbook = Application.Workbooks.Open(FiletoOpen)
lastrowopen = Openbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Openbook.Sheets(1).Range("A2", "AB" & lastrowopen).Copy
lastrowthis = Application.ThisWorkbook.Sheets("Base de Dados").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
ThisWorkbook.Sheets("Base de Dados").Range("A" & lastrowthis).PasteSpecial xlPasteValues

End If

End Sub

一切都很好,直到lastrowthis = Application.ThisWorkbook.Sheets("Base de Dados").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row我收到错误 9,我不确定它有什么问题

有什么建议吗?

标签: excelvba

解决方案


工作簿、工作表和范围

提示

  • 使用Option Explicitwhich 将强制您声明所有变量。
  • 使用变量。
  • 一步一步写。
  • 当只需要值时,只“写入”(“分配”)值会更有效。

编码

Option Explicit

Sub Import_Data()
    
    ' Source
    Dim sFilePath As Variant: sFilePath = Application.GetOpenFilename
    If sFilePath = False Then Exit Sub
    Dim swb As Workbook: Set swb = Workbooks.Open(FiletoOpen)
    Dim sws As Worksheet: Set sws = swb.Worksheets(1)
    Dim sLast As Long: sLast = sws.Cells(sws.Rows.Count, 1).End(xlUp).Row
    Dim srg As Range: Set srg = sws.Range("A2", "AB" & sLast)
    
    ' Destination
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets("Base de Dados")
    Dim dCell As Range:
    Set dCell = dws.Cells(dws.Rows.Count, 1).End(xlUp).Offset(1)
    
    ' Assign (Write)
    dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value

End Sub

推荐阅读