[英]dynamic copy and paste using macro in vba
我試圖將工作簿中一個工作表的列復制並粘貼到另一個工作表和工作簿中。如果我給出工作簿,工作表和列的靜態名稱,則代碼運行良好。這是我使用的代碼。
Dim sourcecolumn As Range, targetcolumn As Range
Set sourcecolumn = Workbooks("Book1.xlsm").Worksheets("sheet1").Columns("A")
Set targetcolumn = Workbooks("Book2.xlsm").Worksheets("sheet2").Columns("B")
sourcecolumn.Copy Destination:=targetcolumn
問題是我想為源和目標工作表,工作簿和列都提供動態名稱。...有人可以幫忙嗎?謝謝
嘗試這樣的事情:
Sub test()
Dim thisWB As Workbook, wb1 As Workbook, wb2 As Workbook
Dim rng1 As Range, rng2 As Range
Dim tmp1, tmp2
On Error GoTo errorHandler
'your current Workbook'
Set thisWB = ThisWorkbook
'select first file'
tmp1 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #1")
If tmp1 = False Then Exit Sub ' File not choosen'
'open first file for selecting range to copy'
Workbooks.Open Filename:=tmp1, ReadOnly:=True
Set wb1 = ActiveWorkbook
'select range to copy (you can select entire row or column)'
Set rng1 = Application.InputBox(Prompt:="Please Select Range to copy", Title:="Range Select", Type:=8)
'select second file'
tmp2 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #2")
If tmp2 = False Then ' File not choosen'
wb1.Close
Exit Sub
End If
'open second file for selecting range where to paste'
If tmp1 = tmp2 Then
Set wb2 = wb1
Else
Workbooks.Open Filename:=tmp2
Set wb2 = ActiveWorkbook
End If
'select range where you need paste values'
Set rng2 = Application.InputBox(Prompt:="Please Select Range where to paste", Title:="Range Select", Type:=8)
rng1.Copy Destination:=rng2
'close workbooks'
wb1.Close
If tmp1 <> tmp2 Then wb2.Close
Exit Sub
'Error handler'
errorHandler:
MsgBox Err.Description, vbCritical, "Error!"
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.