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
Хорошо, это прекрасно работает, кроме как скопировать значения, а не формулы ячеек в sheet1 в sheet2? Как дата переносится как 01.01.1900, когда она должна быть 5/5/2011