Как использовать макрос для копирования и вставки в одну строку, если выполняется условие?

Question

Я все еще новичок в VBA, и я запускаю отчет, и, как я его получаю, в нескольких строках есть дополнительный столбец данных, который мне не нужен, но он портит форматирование этих записей.Например, в столбце BI есть профили, перечисленные для всех, но для этих нескольких записей у меня есть номер или что-то еще (это не согласуется для каждого).Но для тех же самых записей у меня есть «Y» в столбце H, чего нет ни у одной другой записи.Я пытаюсь найти в отчете значение «Y» в столбце H, а затем скопировать столбцы с C по H и вставить его в столбец B, чтобы все данные были выровнены.Из пары сотен записей может быть 6-7, которые необходимо переместить.Вот некоторые примеры данных, которые, я надеюсь, показывают проблему.BTHOMAS Столбец B является проблемой в этом примере.

   A      |    B     |    C    |    D       |    E      |    F      |     G     |   H
--------------------------------------------------------------------------------------------
  ID      | PROFILE  | STATUS  | DATE ADDED | LAST USED | EXP DATE  |  P/W EXP  |
  SBUTLER | NOM      | ENABLED | 9/9/2014   | 10/5/2018 | 00/00/00  |  N        |
  WPERRY  | NOM      | ENABLED | 10/29/2014 | 10/4/2018 | 00/00/00  |  N        |
  BTHOMAS | 1234     | NOM     | ENABLED    | 2/1/2017  | 9/28/2018 |  00/00/00 | Y

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

Sub MoveColumns()

LR = Cells(Rows.Count, "B").End(xlUp).Row
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To a

        If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
            Range("C:H").copy Range("B:G")

        End If

    Next

End Sub

Ожидаемый результат для выравнивания отчета, как в примере ниже.В столбцах с I по J имеются данные, поэтому я могу копировать только столбцы с C по H. Спасибо за ваше время.

 A      |    B     |    C    |    D       |    E      |    F      |     G     |   H
--------------------------------------------------------------------------------------------
  ID      | PROFILE  | STATUS  | DATE ADDED | LAST USED | EXP DATE  |  P/W EXP  |
  SBUTLER | NOM      | ENABLED | 9/9/2014   | 10/5/2018 | 00/00/00  |  N        |
  WPERRY  | NOM      | ENABLED | 10/29/2014 | 10/4/2018 | 00/00/00  |  N        |
  BTHOMAS | NOM      | ENABLED | 2/1/2017   | 9/28/2018 | 00/00/00  |  Y

Answer 1

Вам нужно скопировать только те строки, для которых условие возвращает true.Попробуйте:

If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
    Worksheets("Sheet1").Range("C" & i & ":H" & i).copy Worksheets("Sheet1").Range("B" & i & ":G" & i)
End If

Альтернатива: вы можете удалить ячейку в столбце C, сместив остальные влево:

If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
    Worksheets("Sheet1").Range("C" & i).Delete Shift:=xlToLeft
End If

или

If Worksheets("Sheet1").Cells(i, 8).Value = "Y" Then
    Worksheets("Sheet1").Cells(i, 3).Delete Shift:=xlToLeft
End If

(обратите внимание, что это сместит все ячейки в данной строке и может привести к тому, что вы не хотите)