Смещение и вставка VBA

Question

У меня есть некоторый код VBA, который работает нормально, однако я пытаюсь улучшить свой код, теряя команды выбора.Я узнаю, что это не лучшая практика.Работающий (старый) код приведен ниже:

With Sheets("Data")
        RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

        For i = 1 To RowCount

        Range("B1").Offset(1, 0).Select

If ActiveCell.Offset(0, -1).Value = 2 And ActiveCell.Value = sPeril Then

    ActiveSheet.Cells.Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("DynamicCharts").Select
Sheets("DynamicCharts").Range("E" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data").Select

End If

next i

End With

Код переключается между копированием и вставкой листов с использованием смещенных ячеек.Я пытался изменить это с помощью команды WITH и ее отладки по команде вставки.

With Sheets("Data")
    RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

    For i = 1 To RowCount

    Range("B1").Offset(1, 0).Select

    If ActiveCell.Offset(0, -1).Value = 1 And ActiveCell.Value = sPeril Then

        ActiveSheet.Cells.Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        With Sheets("DynamicCharts")
        .Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        'Sheets("EDM Data").Select

    End If

next i

End With 

Любая помощь по этому вопросу будет очень оценена.

Заранее спасибо

Answer 1

ваш код, но с простым исправлением просто посмотрите на комментарий.Заметьте, я установил для peril значение 2, чтобы код попадал в это состояние.

 Sub test2()
    With Sheets("sheet1")
        RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

        For i = 1 To RowCount

        Range("B1").Offset(1, 0).Select
        sPeril = 2
        If ActiveCell.Offset(0, -1).Value = 1 And ActiveCell.Value = sPeril Then

            ActiveSheet.Cells.Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
            With Sheets("DynamicCharts")
            'remove selection on this line.
            .Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End With
            'Sheets("EDM Data").Select

        End If

    Next i

    End With
    End Sub

Answer 2

Вместо этого сделайте снимок - это полностью устраняет необходимость в Select.Мы могли бы также избавиться от Copy/Paste, но мне нужно знать, что вы пытаетесь донести (возможно, это зависит от формата?).Пожалуйста, включайте больше кода при задании вопроса (например, что такое sPeril и т. Д.):

Dim destrow As Long, lastcol As Long

With Sheets("Data")
    RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

    For i = 2 To RowCount

        If Range("B" & i).Offset(0, -1).Value = 2 And Range("B" & i).Value = sPeril Then

            destrow = Sheets("DynamicCharts").Cells(Sheets("DynamicCharts").Rows.Count, "E").End(xlUp).Row
            lastcol = Sheets("Data").Cells(i, Sheets("Data").Columns.Count).End(xlToLeft).Column

            Sheets("Data").Range(Sheets("Data").Cells(i, 2), Sheets("Data").Cells(i, lastcol)).Copy
            Sheets("DynamicCharts").Range("E" & destrow + 1).PasteSpecial

        End If

    Next i

End With