在vba中使用宏进行动态复制和粘贴

i have tried to copy and paste columns from one worksheet in a workbook to another worksheet and workbook.If i give staticnames of the workbooks,worksheets and the columns then the code is running fine.This is the code i have used.

我试图将工作簿中的一个工作表中的列复制并粘贴到另一个工作表和工作簿。如果我给出工作簿,工作表和列的静态名称,那么代码运行正常。这是我使用的代码。

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

The problem is i want to give dynamic names for both the source and destination worksheets,workbooks and the columns also....can anybody help?thanks in advance

问题是我想为源和目标工作表,工作簿和列提供动态名称....有人可以提供帮助吗?在此先感谢

1 个解决方案

#1

Try something like this:

尝试这样的事情:

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