用于从一个excel文件复制到另一个excel文件的宏

时间:2013-03-13 15:18:24

标签: excel vba

我是使用宏的新手,需要一些帮助从一个excel文件复制行并将其作为列粘贴到另一个excel文件中。我手动完成了第一行,同时录制宏,这里是代码:

Sub Macro2()

Macro2 Macro

Range("D5:L5").Select
Selection.Copy
Windows("New_SET_Data.xlsx").Activate
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Windows("Original_SET_Data.xls").Activate

End Sub

需要对原始excel文件中的多行和工作表执行此操作。

1 个答案:

答案 0 :(得分:1)

放置您的范围,工作表和放大器作为变量的工作簿,然后它更容易解决。使用WorksheetFunction“Transpose”来更改数据 - 如下所示:

Sub Macro2()

Dim wb1 as Workbook, wb2 as Workbook
Dim ws1 as Worksheet, ws2 as Worksheet
Dim rngSource as Range, Dim rngDest as Range, rngTemp as Range
Dim varArray() as Variant

Set wb1 = Workbooks("Original_SET_Data.xls")
Set wb2 = Workbooks("New_SET_Data.xlsx")
'To work through all sheets in Original_Set_Data.xls, you can replace this line with a "For each ws1 in wb1.Worksheets" loop and put Next at the end.
Set ws1 = wb1.Worksheets("Whatever_The_Source_Sheet_Is_Called")
Set ws2 = wb2.Worksheets("Whatever_The_Destination_Sheet_Is_Called")

'Find the Source Range & Next Available Destination Column
Set rngSource = ws1.Range("D5", ws1.Range("D60000").end(xlUp).Address)
Set rngDest = ws2.Range("IV7").End(xlToLeft).Offset(0,1)

'Loop through Source Range and Transpose Data

For each rngTemp in rngSource
     'Put values from columns D to L into an array
     varArray = ws1.Range(rngTemp, rngTemp.Offset(0, 8).Value)
     'Transpose data - there are 9 columns D to L so we resize the range to be 9 rows high
     rngDest.Resize(9,1).Value = WorksheetFunction.Transpose(varArray)
     'Move to next column in new sheet
     Set rngDest = rngDest.Offset(0,1)
Next

End Sub