L oop копирует ячейку в одну ячейку назначения вместо перехода к следующей - PullRequest
0 голосов
/ 09 января 2020

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

Пока все хорошо, но скопированные ячейки всегда заканчиваются в той же ячейке назначения, вместо перемещения вниз на одну строку.

enter image description here

Sub count()
Option Explicit

    Dim r As Range, i As Long, lastrow As Long, ro As Range, sh As Worksheet, cuweek As Range, myrange As Range
    'i = 6
    lastrow = Sheets("Sheet3").Cells(Rows.count, "A").End(xlUp).Row
    'Set myrange = r.Offset(2, 0)

    Set CopyR = Sheets("Sheet3").Cells(lastrow, "A").Offset(1, 0)

    Set cuweek = Sheets("Dashboard").Range("G5")
    Set sh = Sheets("Input")
    Set ro = sh.Range("B3:TC3")

    For Each r In ro
        Set myrange = r.Offset(2, 0)

        If WorksheetFunction.WeekNum(r) = cuweek Then
            'MsgBox (myrange)
            myrange.Copy Destination:=CopyR
        End If
    Next

End Sub

1 Ответ

1 голос
/ 09 января 2020

Согласно комментариям, обновите ячейку назначения внутри вашего l oop (вы также можете установить ее внутри своего l oop).

Строго говоря, я не думаю, что вам вообще нужна переменная (или некоторые другие), но это довольно тангенциально.

Sub count()

Dim r As Range, i As Long, ro As Range, sh As Worksheet, cuweek As Range, myrange As Range

Set cuweek = Sheets("Dashboard").Range("G5")
Set sh = Sheets("Input")
Set ro = sh.Range("B3:TC3")

For Each r In ro
    Set myrange = r.Offset(2, 0)
    If WorksheetFunction.WeekNum(r) = cuweek Then
        Set CopyR = Sheets("Sheet3").Cells(Rows.count, "A").end(xlup).Offset(1, 0)
        myrange.Copy Destination:=CopyR
    End If
Next

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