如果满足条件，如何使用宏在同一行中进行复制和粘贴？

Question

我还是 VBA 的新手，我是运行一份报告，我收到报告的方式有几行有我不需要的额外数据列但它弄乱了这些条目的格式。例如，在 B 列中，我列出了每个人的配置文件，但对于这几个条目，我有一个数字或其他东西（每个条目都不一致）。但是对于那些相同的条目，我在 H 列中有一个 "Y"，其他条目的 none 有。我正在尝试在报告中搜索 H 列中的 "Y"，然后复制 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

我对复制和粘贴宏进行了大量研究，但我发现的所有内容要么是单个单元格，要么是整行，他们将其粘贴到另一个 sheet。我只想复制并粘贴在同一行中。这是我目前的代码，不幸的是它移动了每一列。

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

您只需复制条件 returns 为真的行。尝试：

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

（请注意，这将移动给定行上的所有个单元格，并可能导致您不想要的结果）

如果满足条件，如何使用宏在同一行中进行复制和粘贴？

How do I use a macro to copy and paste in the same row if a condition is met?

excel

vba

if-statement

copy

paste