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

Question

I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").

So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!

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 you need two conditions, then you should write them carefully in the IF statement with And :

Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.

Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA

Answer 2

The Sub bellow does the following

• Determine the last used row in Worksheets("2") based on values in column A
• Determine the last used col in Worksheets("2") based on values in row 1
• Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
• Loop through all used rows in Worksheets("2")
  • If the cell in col A is not empty And cell in col G is empty
    • Copy entire row to next empty row in Worksheets("Core_Cutter_List")
    • Increment next empty row for Worksheets("Core_Cutter_List")
  • Loop to the next used row in 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

---

My test file

Worksheets("2")

Worksheets("Core_Cutter_List")