如果列A包含文本，列G为空白，则将行复制到新电子表格

Question

我正在尝试为下游应用程序中的人员创建摘要列表，以供多台生产机器使用。 每台机器都将有自己的标签来请求材料，我希望将所有请求汇总在一个标签上（称为“ Core_Cutter_List”）。

因此，基本上，我试图创建一个VBA，该行将从电子表格“ 2”的一行复制到电子表格“ Core_Cutter_List”的下一个空白行。 如果列A中有文本，列G为空白，我希望它复制。 我对VBA的了解有限。 我发现的代码只能测试我的条件之一，即G列为空，但基本上它遍历了文件中的每个单元格。 您知道如何添加带有文本的A列的其他条件，以使它不会遍历工作表中的每个单元格吗？ 谢谢你的帮助！

Sub Test()
'
' Test Macro
'

  Sheets("2").Select

For Each Cell In Sheets(1).Range("G:G")
    If Cell.Value = "" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets("Core_Cutting_List").Select
        ActiveSheet.Rows(matchRow).Select
        ActiveSheet.Paste
        Sheets("2").Select
    End If
Next
End Sub

Answer 1

如果需要两个条件，则应在IF语句中使用And小心地编写它们：

像If cell.Value = "" And Len(cell.Offset(0,-6)) Then应该可行。

不建议使用“ Select ，但建议从一开始就可以使用 - 如何避免在Excel VBA中使用“选择”

Answer 2

子波纹管执行以下操作

• 根据列A中的值确定Worksheets（“ 2”）中最后使用的行
• 根据第1行中的值确定Worksheets（“ 2”）中最后使用的列
• 根据列A中的值确定Worksheets（“ Core_Cutter_List”）中最后使用的行
• 遍历工作表中所有使用的行（“ 2”）
  • 如果列A中的单元格不为空且列G中的单元格为空
    • 将整行复制到工作表中的下一个空行（“ Core_Cutter_List”）
    • 增加工作表的下一个空行（“ Core_Cutter_List”）
  • 循环到Worksheets（“ 2”）中的下一个使用的行

---

Option Explicit

Public Sub CopyRows()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
    Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long

    Set ws1 = ThisWorkbook.Worksheets("2")
    Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")

    ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row        'last row in "2"
    ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
    ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1    'last row in "Core_Cutter"

    For i = 1 To ws1lr

        If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then

            Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
            Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))

            ws2r.Value2 = ws1r.Value2
            ws2lr = ws2lr + 1
        End If

    Next i

End Sub

---

我的测试文件

工作表（ “2”）

工作表（ “Core_Cutter_List”）