如何將數據從一個工作簿復制到另一個？

Question

我有以下場景

• 文件 A 位於 D:\\working\\Project_rev1.xltm 與 Sheet1、Sheet2 和 Sheet3

• 文件 B 位於 D:\\Templates\\BudgetReport.xltm 與 SheetX、SheetY 和 SheetZ

• 文件 A 中的宏以打開文件 B

• 將數據從文件 A 中的單元格（比如 Sheet1 范圍 B1、B3、B5）復制到文件 B（比如 SheetY 范圍 A1、A3、A5`）

• SaveAs為 xlsx 格式的文件 B。

我得到

子集超出范圍

Sub Copy()
    Dim objExcel As Object
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    
    Dim objBudget As Object
    Set objBudget = objExcel.Workbooks.Add("D:\Templates\BudgetReport.xltm")
    
    Thisworkbook.Worksheets("Sheet1").Range("B1").Copy
    Workbooks("objBudget").Worksheets("SheetY").Range("A1")
End Sub

Answer 1

使用模板創建報表工作簿

• 你可以從這個開始，慢慢地朝着想要的結果發展。

編碼

Option Explicit

Sub createReport()
    
    ' Destination
    Const dFilePath As String = "D:\Templates\BudgetReport.xltm"
    Dim dwb As Workbook
    Set dwb = Workbooks.Open(dFilePath)
    Dim dst As Worksheet
    Set dst = dwb.Worksheets("SheetY")
    
    ' Source
    Dim swb As Workbook
    Set swb = ThisWorkbook ' The workbook containing this code.
    Dim src As Worksheet
    Set src = swb.Worksheets("Sheet1")
    
    ' Copy values by assignment.
    dst.Range("A1").Value = src.Range("B1").Value
    dst.Range("A3").Value = src.Range("B3").Value
    dst.Range("A5").Value = src.Range("B5").Value
    
    ' 'Application.DisplayAlerts' set to 'False' allows you to overwrite files
    ' without 'Excel' asking you to save them or not. Remove both occurrences
    ' if you don't want this functionality.
    Application.DisplayAlerts = False
    ' Save Destination workbook.
    dwb.SaveAs _
      Filename:=Left(dFilePath, InStrRev(dFilePath, ".") - 1), _
      FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ' Close Destination workbook.
    dwb.Close
    
End Sub