I have tens of individual cells that need to be copied from a daily report to a master sheet every day. The cells that need to be copied are found on different rows in the daily report, and need to be paste into various cells in the master.
My VBA:
`Sub COPYCELL()
Dim wbk As Workbook
strFirstFile = "c:\daily_report-2016-07-19.xlsx"
strSecondFile = "c:\testbook.xlsx"
Set wbk = Workbooks.Open(strFirstFile)
With wbk.Sheets("(Data)")
Range("C31", "D31", "E31").Copy
End With
Set wbk = Workbooks.Open(strSecondFile)
With wbk.Sheets("Sheet1")
Range("KD213", "KE213", "KJ213").PasteSpecial
End With
End Sub
`
So C31 goes to KD213, D31 to KE213 etc.. but this gives an error since excel can only deal with 2 cells to copy.
Anyone know how to add additional copy cells and destinations?
Thanks!
Here is a simple way:
Sub COPYCELL()
Dim wbk1 As Workbook, wbk2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
strFirstFile = "c:\daily_report-2016-07-19.xlsx"
strSecondFile = "c:\testbook.xlsx"
Set wbk1 = Workbooks.Open(strFirstFile)
Set ws1 = wbk1.Sheets("(Data)")
Set wbk2 = Workbooks.Open(strSecondFile)
Set ws2 = wbk2.Sheets("Sheet1")
With ws2
.Range("KD213").Value = ws1.Range("C31").Value
.Range("KE213").Value = ws1.Range("D31").Value
.Range("KJ213").Value = ws1.Range("E31").Value
End With
End Sub
You can call as many ranges (currently manually) as you wish with a short sub-routine called Sub CopyManyRanges(Range_Orig As String, Range_Dest As String)
Option Explicit Section:
Option Explicit
Dim wb_first As Workbook
Dim wb_second As Workbook
Dim sht_data As Worksheet
Dim sht_1 As Worksheet
Your COPYCELL Routine:
Sub COPYCELL()
Dim strFirstFile As String
Dim strSecondFile As String
strFirstFile = "c:\daily_report-2016-07-19.xlsx"
strSecondFile = "c:\testbook.xlsx"
Set wb_first = Workbooks.Open(strFirstFile)
Set wb_second = Workbooks.Open(strSecondFile)
Set sht_data = wb_first.Sheets("(Data)")
Set sht_1 = wb_second.Sheets("Sheet1")
' you can add a For Loop here
Call CopyManyRanges("C31", "KD213")
Call CopyManyRanges("D31", "KE213")
Call CopyManyRanges("E31", "KJ213")
End Sub
Sun CopyManyRanges Routine:
Sub CopyManyRanges(Range_Orig As String, Range_Dest As String)
sht_data.Range(Range_Orig).Copy
sht_1.Range(Range_Dest).PasteSpecial
End Sub
Here's another way to do it by capturing the ranges then looping through them. Just make sure you set the ranges in the proper order.
Sub COPYCELL()
Dim wbk As Workbook
Dim strFile as String
strFile = "c:\daily_report-2016-07-19.xlsx"
Set wbk = Workbooks.Open(strFile)
Dim rng1 as Range
Set rng1 = wbk.Sheets("(Data)").Range("C31,D31,E31") 'add more as needed
wbk.Close false
strFile = "c:\testbook.xlsx"
Set wbk = Workbooks.Open(strFile)
Dim rng2 as Range
Set rng2 = wbk.Sheets("Sheet1").Range("KD213,KE213,KJ213") 'add more as needed
Dim i as Long
For each cel in rng2
cel.Value = rng1.Cells(i+1)
i = i + 1
Next
wkb.Close True
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.