简体   繁体   中英

Copy and paste with array macro excel

Can anybody help me edit? I want to copy from column to another workbook column using array. The range inside the array is the Alphabet of the column i want to copy/paste.

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

Your problem is source().End(xlUp).Row . You're trying to use it as a range - which it's not. That is giving you the error.

You'd be better to populate your array by using a loop. And, unless you really want to carry the cell formatting across to the destination sheet, better not to use Copy since then you don't have to activate the destination sheet.

Not sure if the code below exactly fits your need. I wasn't sure of the purpose of log() array so I've left it out. The below copies the values of a single column from Source sheet to Destination sheet.

'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

Try this.
I assume you need copy the value from range E11 to E17 and J11 to 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

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM