Excel VBA Скопируйте и вставьте диапазон ячеек многократно в колонку

Question

Я пробовал это двумя разными способами.

Сначала выберите диапазон ячеек для копирования и выберите диапазон назначения для вставки. Ниже приведен код:

Sub PanelData() 

Dim size As Integer 
Dim i As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 


Set shrate = Sheets("Rate") 
Set shpanel = Sheets("Panel") 

size = shrate.Range("B4").End(xlDown).Row 

shrate.Range(Cells(4, 2), Cells(size, 2)).Select 
Selection.Copy 

shpanel.Cells(1, 1).Value = size - 3 

For i = 1 To 18 

shpanel.Range(Cells(4, 1).Offset((i - 1) * (size - 3), 0), Cells(3, 1).Offset(i * (size - 3), 0)).Select 
     Selection.PasteSpecial Paste:=xlPasteValues 
     Selection.NumberFormat = "m/d/yyyy" 

Next i 

End Sub 

Во-вторых, скопируйте ячейки в диапазоне и вставьте в столбец назначения один за другим. Вот код:

Sub LoopingCP() 
Dim size As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 

Set shrate = Sheets(2) 
Set shpanel = Sheets(4) 

size = shrate.Cells(4, 2).End(xlDown).Row - 3 

For x = 1 To 18 

    For i = 1 To size 
     shrate.Cells(i + 3, 2).Select 
      Selection.Copy 

     shpanel.Cells(x * (i + 3), 1).Select 
      Selection.PasteSpecial Paste:=xlPasteValues 
      Selection.NumberFormat = "m/d/yyyy" 

    Next i 

Next x 
End Sub 

Ни одна из этих попыток не разработана. Что я сделал не так?

Thanks

Answer 1

Пара вещей, мешающих этому работать. Во-первых, при использовании переменной диапазона, такой как Range(), Cells(), Rows(), Columns() и т. Д., Вы должны всегда быть явным с листом, который вы ожидаете запустить.

Во-вторых, вы хотите избежать использования .Select, о чем я говорил в комментарии. По сути, вы просто «обратно» две строки кончая, и начиная с, .Select/.Selection

Смотрите, если это работает:

Sub PanelData() 

Dim size As Integer 
Dim i As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 


Set shrate = Sheets("Rate") 
Set shpanel = Sheets("Panel") 

size = shrate.Range("B4").End(xlDown).Row 

shrate.Range(shrate.Cells(4, 2), shrate.Cells(size, 2)).Copy 

shpanel.Cells(1, 1).Value = size - 3 

For i = 1 To 18 
    With shpanel.Range(shpanel.Cells(4, 1).Offset((i - 1) * (size - 3), 0), shpanel.Cells(3, 1).Offset(i * (size - 3), 0)) 
     .PasteSpecial Paste:=xlPasteValues 
     .NumberFormat = "m/d/yyyy" 
    End With 
Next i 

End Sub 

Sub LoopingCP() 
Dim size As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 

Set shrate = Sheets(2) 
Set shpanel = Sheets(4) 

size = shrate.Cells(4, 2).End(xlDown).Row - 3 

For x = 1 To 18 
    For i = 1 To size 
     shrate.Cells(i + 3, 2).Copy 
     With shpanel.Cells(x * (i + 3), 1) 
      .PasteSpecial Paste:=xlPasteValues 
      .NumberFormat = "m/d/yyyy" 
     End With 
    Next i 
Next x 
End Sub 

FYI - когда вы просто хотите, чтобы значения, вы можете установить значения диапазонов равны друг другу, вместо использования .Copy/.Paste, которая сохраняет буфер от использования и экономит немного время при запуске макроса:

Range([destination range]).Value = Range([copy from range]).Value (и, пожалуйста, обратите внимание, что вам нужно включить имя листа перед Range() , конечно.