使用数组宏excel进行复制和粘贴

时间:2015-06-25 09:12:47

标签: arrays excel vba excel-vba

有人可以帮我编辑吗?我想使用数组从列复制到另一个工作簿列。 数组内的范围是我要复制/粘贴的列的字母。

Sub setting2()
    Dim wb As ThisWorkbook

    Dim here As Workbook
    Dim there As Workbook

    Dim source() As Variant

    Dim log() As Variant

    Dim LastRowHere() As Integer
    Dim LastRowThere() As Integer 

    'Open both workbooks first:
    Set here = Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting2.xlsm")
    Set there =Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting3.xlsm")

    Windows("Setting.xlsm").Activate
    source() = Array(Sheets("Sheet1").Range("E11"), Range("E12"), Range("E13"), Range("E14"), Range("E15"), Range("E16"),Range("E17").Value)

    Windows("Setting.xlsm").Activate
    log() = Array(Sheets("Sheet1").Range("J11"), Range("J12"),Range("J13"),Range("J14"), Range("J15"), Range("J16"), Range("J17").Value)

    Windows("Setting2.xlsm").Activate
    LastRowHere() = Array(Sheets("Sheet1").Rows.Count, source().End(xlUp).Row)

    Windows("Setting3.xlsm").Activate
    LastRowThere() = Array(Sheets("Sheet1").Rows.Count, log()).End(xlUp).Row

    For i = 1 To LastRowHere()

    LastRowThere(1) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count.log(1)).End(xlUp).Row

        For k = 1 To LastRowThere()

            'here.Sheets("Sheet1").Cells(i, k).Copy Destination:=there.Sheets("Sheet1").Cells(i, k)
    here.Sheets("Sheet1").Rows(i).Columns(source(1)).Copy Destination:=there.Sheets("Sheet1").Rows(k + 1).Columns(log(1))

        Next k
    Next i

    End Sub

2 个答案:

答案 0 :(得分:0)

您的问题是source().End(xlUp).Row。你试图将它用作范围 - 它不是。那是给你错误的。

最好使用循环填充数组。并且,除非您确实希望将单元格格式传递到目标工作表,否则最好不要使用Copy,因为这样您就不必激活目标工作表。

不确定以下代码是否完全符合您的需要。我不确定log()数组的用途,所以我把它遗漏了。下面将单个列的值从“源表”复制到“目标表”。

'Open both workbooks first:
Set here = Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting2.xlsm")
Set there =Workbooks.Open("C:\Users\jesslynn\Desktop\macro\Setting3.xlsm")

SourceCol = 5  'Column E from your example

Set SourceSht = here.Sheets(1)
Set DestnSht = there.Sheets(1)

With SourceSht  
    'Get last cell in the column 
    LastRow = .Cells(.Rows.Count, SourceCol).End(xlUp).row
End With

With DestnSht
    'Get last cell in the column 
    DestnLastRow = .Cells(.Rows.Count, SourceCol).End(xlUp).row
End With

'Loop through all cells (assumes row 1 is header)
For r = 2 to LastRow 
    'Assign value from Source to Destination sheet
    i = i + 1
    DestnSht.Cells(DestnLastRow + i, SourceCol) = SourceSht.Cells(r, SourceCol)
Next

答案 1 :(得分:0)

试试这个。
我假设您需要复制范围E11到E17和J11到J17

的值
Option Explicit
Dim CurrentWorkbook As Workbook
Dim SourceWorkbook As Workbook
Dim DestWorkbook As Workbook
Dim CurrentWorksheet As Worksheet
Dim SourceWorksheet As Worksheet
Dim DestWorksheet As Worksheet

Sub setting2()

Dim SourceLastRow As Long
Dim DestLastRow As Long

Set CurrentWorkbook = ActiveWorkbook
Set CurrentWorksheet = CurrentWorkbook.ActiveSheet

Set SourceWorkbook = Workbooks.Open("C:\Users\lengkgan\Desktop\Testing\MyData1.xlsx") 'change to your path
Set DestWorkbook = Workbooks.Open("C:\Users\lengkgan\Desktop\Testing\MyTemplate.xlsx") 'change to your path

Set SourceWorksheet = SourceWorkbook.Sheets(1)
Set DestWorksheet = DestWorkbook.Sheets(1)

SourceLastRow = SourceWorksheet.Cells(Rows.Count, "E").End(xlUp).Row
DestLastRow = DestWorksheet.Cells(Rows.Count, "J").End(xlUp).Row + 1

SourceWorksheet.Range("E11:E17").Copy Destination:=DestWorksheet.Range("E" & DestLastRow + 1) 'Change to the column you want
SourceWorksheet.Range("J11:J17").Copy Destination:=DestWorksheet.Range("J" & DestLastRow + 1) 'Change to the column you want

End Sub