Увеличение диапазона для каждой итерации - PullRequest
3 голосов
/ 09 октября 2019

Я автоматизирую лист Excel для своей работы и застрял в проблеме.

Я пытаюсь скопировать определенный диапазон (A3: D3) и вставить его в конечный ряд другой книги. Я пытаюсь использовать оператор if для фильтрации диапазонов с номером 0 в ячейке B3.

Пожалуйста, помогите. Я полный новичок, и я только начинаю. Извините, если есть много вопросов.

Я пытался изменить диапазон на ячейку (i, 2), но он копирует только B3, а не остальные (A3: D3).

Редактировать: забыл добавить sв ячейках Edit2: мне просто нужно скопировать четыре ячейки (A3: D3) и увеличить их на следующей итерации, чтобы скопированная ячейка была (A4: D4)

Sub CopyData()

Dim wsCopy As Worksheet, wsDest As Worksheet
Dim iCopyLastRow As Long, iDestLastRow As Long

Set wsCopy = Workbooks("file1.xlsx").Worksheets("trend")
Set wsDest = Workbooks("file2.xlsx").Worksheets("raw data")

iCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

    For i = 3 To iCopyLastRow
        If wsCopy.Cells(i, 2).Value = 0 Then

        Else
        wsCopy.range(Cell(i,2), Cell(i,4)).Copy
        'wsCopy.Cells(i, 2). Copy ##this copies just one cell

        iDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
        wsDest.range("A" & iDestLastRow).PasteSpecial xlPasteValues
        End If

    Next i

Error messages:

Время выполненияошибка '1004':

Метод 'Range' объекта '_Worksheet' завершился ошибкой

, и отладка выделяет wsCopy.range(Cell(i,2), Cell(i,4)).Copy, оператор после else

Ответы [ 2 ]

1 голос
/ 09 октября 2019

Попробуйте использовать этот код:

Sub CopyData()
    Dim wsCopy As Worksheet, wsDest As Worksheet
    Dim iCopyLastRow As Long, iDestLastRow As Long

    Set wsCopy = Workbooks("file1.xlsx").Worksheets("trend")
    Set wsDest = Workbooks("file2.xlsx").Worksheets("raw data")

    iCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

    For i = 3 To iCopyLastRow
        If wsCopy.Cells(i, 1).Value <> 0 Then
            'A = 1, D = 4
            wsCopy.Range(wsCopy.Cells(i, 1), wsCopy.Cells(i, 4)).Copy

            iDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row

            wsDest.Range("A" & iDestLastRow).PasteSpecial xlPasteValues
        End If
    Next i
End Sub

Просто убедитесь, что iCopyLastRow и iDestLastRow - это ожидаемые значения.

Надеюсь, это поможет.

0 голосов
/ 09 октября 2019

Попробуйте приведенный ниже код, он готов к использованию в цикле:

Sub CopyAndAppend()
    Dim destSheet As Worksheet, srcSheet As Worksheet, lastRow As Long
    Set destSheet = Worksheets("Sheet2")
    Set srcSheet = Worksheets("Sheet1")
    ' determine last row in Sheet2
    lastRow = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row

    Dim i As Long
    i = 3
    ' copy range A3:D3 and paste it right after last row in Sheet2
    srcSheet.Range(srcSheet.Cells(i, 1), srcSheet.Cells(i, 4)).Copy destSheet.Cells(lastRow + 1, 1)
    ' increment row index
    i = i + 1
    ' do something else
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...