Блог

 Private Sub CommandButton1_Click()
Dim rCell As Range
Dim i As Long
Dim rNext As Range
'loop through the cells in column A of the source sheet
For Each rCell In Sheet1.Range("A3:U25")
    'loop as many times as the value in column U of the source sheet
    For i = 1 To rCell.Offset(0, 22).Value
        'find the next empty cell to write to in the dest sheet
        Set rNext = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0)
        'copy A and B from source to the dest sheet
        rCell.Resize(1, 22).Copy rNext.Resize(1, 1)

        Next i
    Next rCell
End Sub
  

Хорошо, это отлично работает, за исключением того, как мне скопировать значения, не являющиеся формулами, ячеек листа 1 в лист2? Например, дата передается как 1/0/1900, когда она должна быть 5/5/2011

Вам нужно использовать специальный метод PasteSpecial с xlPasteValues в качестве PasteType. Что-то вроде:

 Sheet2.Cells(1,1).PasteSpecial xlPasteType.xlPasteValues
  

 Private Sub CommandButton1_Click()
Dim rCell As Range
Dim i As Long
Dim rNext As Range
'loop through the cells in column A of the source sheet
For Each rCell In Sheet4.Range("A3:U25")
    'loop as many times as the value in column U of the source sheet
    For i = 1 To rCell.Offset(0, 23).Value
        'find the next empty cell to write to in the dest sheet
        Set rNext = Sheet12.Cells(Sheet12.Rows.Count, 1).End(xlUp).Offset(1, 0)
        'copy A and B from source to the dest sheet
        rCell.Resize(1, 23).Copy
        rNext.Resize(1, 1).PasteSpecial (xlPasteValues)
    Next i
Next rCell
End Sub
  

Теперь я получаю несоответствие типа runtime-13 в приведенной ниже части кода. При возникновении ошибки нажмите end, и все будет работать нормально. Не хочу нажимать end.
Для i = 1 в rCell.Смещение (0, 23).Значение