Код работает отлично, за исключением необходимости устанавливать значения, а не формулы - PullRequest
1 голос
/ 07 мая 2011
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

Ответы [ 2 ]

1 голос
/ 07 мая 2011

Вам необходимо использовать метод PasteSpecial с xlPasteValues ​​в качестве PasteType.Что-то вроде:

Sheet2.Cells(1,1).PasteSpecial xlPasteType.xlPasteValues
0 голосов
/ 08 мая 2011
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

Теперь я получаю несоответствие типов во время выполнения-13 в нижней части кода.Когда это ошибка, нажмите конец, и он работает нормально.Не хочу нажимать конец.Для i = 1 до rCell.Offset (0, 23). Значение

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...