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
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
The Sub bellow does the following
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")
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.