2015-06-25 2 views
0

Может кто-нибудь помочь мне редактировать? Я хочу скопировать из колонки в другой столбец книги, используя массив. Диапазон внутри массива - это алфавит столбца, который я хочу скопировать/вставить.Скопировать и вставить с массивом macro excel

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 
+0

Что не работает в текущем коде? – moffeltje

+0

Windows ("Setting2.xlsm"). Активировать LastRowHere() = Массив (Листы 1). Строки. Источник,(). Окончание (xlUp) .Row) – jesslynn

+0

@moffeltje источник является недопустимым квалификатором – jesslynn

ответ

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 
+0

Чтобы установить столбец «Лист цели» на основе указанного алфавита столбца пользователя. 'DestnSht.Range (SpecCol & (DestnLastRow + i)) = SourceSht.Cells (r, SourceCol)' –

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 
Смежные вопросы