简体   繁体   中英

How to copy data from one workbook to another?

I have the following scenario

  • File A is at D:\\working\\Project_rev1.xltm with Sheet1, Sheet2 and Sheet3

  • File B is at D:\\Templates\\BudgetReport.xltm with SheetX, SheetY and SheetZ

  • Macro in File A to open File B

  • Copy data from cells in File A (say Sheet1 Range B1, B3, B5) to File B (say SheetY Range A1, A3, A5`)

  • SaveAs the File B in xlsx format.

I get

Subset out of Range

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

Use Template to Create Report Workbook

  • You can start with this and slowly build towards the desired result.

The Code

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM