I was wondering what the code would be so that when I color a cell when it was colored say yellow it would copy the entire row to another workbook. I am very new to VBA still. I do not have a sheet to upload currently.
~CaptTrout
~CaptTrout
New blog post:
Sub Test() 'assuming the data is in sheet1 Sheets("Sheet1").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row For i = 1 To RowCount 'assuming the true statment is in column a Range("a" & i).Select check_value = ActiveCell If check_value = "True" Or check_value = "true" Then ActiveCell.EntireRow.Copy 'assuming the data is in sheet2 Sheets("C:\Users\alec trout\Desktop[book2.xlsm]sheet1").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Range("a" & RowCount + 1).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next End Sub
Sub Test() 'assuming the data is in sheet1 Sheets("Sheet1").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Dim wb1 As Excel.Workbook Dim wb2 As Excel.Workbook Set wb1 = ActiveWorkbook '// Change to suit... Workbooks.Open Filename:="C:\Temp\xx.xlsx" Set wb2 = ActiveWorkbook wb1.Activate For i = 1 To RowCount 'assuming the true statment is in column a Range("a" & i).Select check_value = ActiveCell If check_value = "True" Or check_value = "true" Then 'ActiveCell.EntireRow.Copy 'assuming the data is in sheet2 wb2.Activate wb2.Sheets("Sheet2").Activate RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Range("a" & RowCount + 1).Select wb1.Sheets("Sheet1").Range("A" & CStr(i)).EntireRow.Copy ActiveCell 'ActiveSheet.Paste wb1.Activate End If Next End Sub
Sub Test() 'assuming the data is in sheet1 Sheets("Sheet1").Select RowCount = Cells(Cells.Rows.Count, "q").End(xlUp).Row Dim wb1 As Excel.Workbook Dim wb2 As Excel.Workbook Set wb1 = ActiveWorkbook '// Change to suit... Workbooks.Open Filename:="C:\Users\alec trout\Desktop\HOT PARTS LIST Blank.xlsx" Set wb2 = ActiveWorkbook wb1.Activate For i = 1 To RowCount 'assuming the true statment is in column a Range("q" & i).Select check_value = ActiveCell If check_value = "True" Or check_value = "true" Then 'ActiveCell.EntireRow.Copy 'assuming the data is in sheet2 wb2.Activate wb2.Sheets("Sheet2").Activate RowCount = Cells(Cells.Rows.Count, "q").End(xlUp).Row Range("a" & RowCount + 1).Select wb1.Sheets("Sheet1").Range("q" & CStr(i)).EntireRow.Copy ActiveCell 'ActiveSheet.Paste wb1.Activate End If Next End Sub
Sub Copy() 'assuming the data is in sheet1 Sheets("Weld Shop").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Dim wb1 As Excel.Workbook Dim wb2 As Excel.Workbook Set wb1 = ActiveWorkbook '// Change to suit... Workbooks.Open Filename:="C:\Users\alec trout\Desktop\HOT PARTS LIST Blank.xlsx" Set wb2 = ActiveWorkbook wb1.Activate For i = 1 To RowCount 'assuming the true statment is in column a Range("q" & i).Select check_value = ActiveCell If check_value = "True" Or check_value = "true" Then 'ActiveCell.EntireRow.Copy 'assuming the data is in sheet2 wb2.Activate wb2.Sheets("PartsList").Activate RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Range("a" & RowCount + 1).Select wb1.Sheets("Weld Shop").Range("a" & CStr(i)).EntireRow.Copy ActiveCell wb1.Activate End If Next End Sub
Comment