Excel VBA Копирование и вставка ячеек с определенными значениями в диапазоне от одного рабочего листа до другого

Question

Я пытаюсь l oop просмотреть диапазон ячеек, скопировать и вставить значения тех, которые не являются пустыми или не содержат "X" (а также ячейку два справа от нее) в столбцы на другом листе. Я надеюсь, что ячейки, в которые я их вставляю, сохранят предварительно отформатированное условное форматирование, настроенное до того, как в него будет вставлен материал. То, что у меня до сих пор не работает, и не учитывает две ячейки рядом с копируемой ячейкой или просто вставляет значение без форматирования. Было бы здорово, если бы я мог отсортировать первую пару пар по алфавиту (также не учитывается). Спасибо за любую помощь!

Sub Wire_List_Export()

Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim c As Range
Dim j As Integer

Set copySheet = Worksheets("LV Schedule")
Set pasteSheet = Worksheets("test")

For Each c In copySheet.Range("G274:G10000")
    If Not c = "X" Or Not IsEmpty(c) Then
        copySheet.Cells(c).Copy pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If
Next c
End Sub

Answer 1

Это то, что вы ищете?

Sub Wire_List_Export()

    'Declarations.
    Dim RngCopyRange As Range
    Dim IntOffsetCopy As Integer
    Dim RngPasteRange As Range
    Dim RngCell As Range

    'Turning off screen updating.
    Application.ScreenUpdating = False

    'Setting variables.
    Set RngCopyRange = Worksheets("LV Schedule").Range("G274:H10000")
    Set RngPasteRange = Worksheets("test").Range("A1:B9727")

    'Copying the range.
    RngCopyRange.Copy

    'Pasting the range (only values, skipping blank cells).
    RngPasteRange.PasteSpecial Paste:=xlPasteValues, _
                               Operation:=xlNone, _
                               SkipBlanks:=True, _
                               Transpose:=False

    'Turning off cut-copy mode.
    Application.CutCopyMode = False

    'Turning on screen updating.
    Application.ScreenUpdating = True

End Sub