Excel Vba to cut and paste data to other workbook if condition has been met

[XQ4585]

I have collected data in Sheet A in Workbook A, i need to transfer data to Sheet B in Workbook B daily, so i need vba to detect if one of the column "Status" has showed value "Done", and then excel vba transfer data. Please help, i cant figure out how to write the code......Thanks.

 

[Saurabhj]

Hi,

Please check below code:

Sub copyData()
Dim lastRow As Integer, rowno As Integer
Dim RowToCopy As Integer
Dim wb As Workbook

lastRow = ThisWorkbook.Sheets("SheetA").Cells(Rows.Count, 1).End(xlUp).Row
Set wb = Workbooks("result.xlsx")

For rowno = 1 To lastRow
    RowToCopy = wb.Sheets("SheetB").Cells(Rows.Count, 1).End(xlUp).Row + 1
    If ThisWorkbook.Sheets("SheetA").Range("L" & rowno) = "Done" Then
        ThisWorkbook.Sheets("SheetA").Range(rowno & ":" & rowno).Copy wb.Sheets("SheetB").Range(RowToCopy & ":" & RowToCopy)
    End If
Next
MsgBox "Data copied successfully", vbInformation
End Sub

 

[XQ4585]

Hi,

Please check below code:

Sub copyData()
Dim lastRow As Integer, rowno As Integer
Dim RowToCopy As Integer
Dim wb As Workbook

lastRow = ThisWorkbook.Sheets("SheetA").Cells(Rows.Count, 1).End(xlUp).Row
Set wb = Workbooks("result.xlsx")

For rowno = 1 To lastRow
    RowToCopy = wb.Sheets("SheetB").Cells(Rows.Count, 1).End(xlUp).Row + 1
    If ThisWorkbook.Sheets("SheetA").Range("L" & rowno) = "Done" Then
        ThisWorkbook.Sheets("SheetA").Range(rowno & ":" & rowno).Copy wb.Sheets("SheetB").Range(RowToCopy & ":" & RowToCopy)
    End If
Next
MsgBox "Data copied successfully", vbInformation
End Sub

Hi, thanks for reply, here a image may more clear to reach out what i try to explain. i have Workbook name "Book1" and sheet name "Data" i wish to copy the data when "Confirmed by" column show "HOD" and paste to another worksheet name "Book2" sheet name "Done". Im trying to write vba code but does not work....

 

[Saurabhj]

Hi, Seems it's a duplicate post.

Meanwhile use below code in Data Sheet of Book1. keep both workbook open.
When you type HOD, the row will be copied in Done sheet of book2.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim targetRow As Integer
Set wb = Workbooks("Book2.xlsx")
targetRow = wb.Sheets("Done").Cells(Rows.Count, 1).End(xlUp).Row + 1
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("E:E")) Is Nothing Then
    If Range("E" & Target.Row) = "HOD" Then
        ActiveSheet.Range(Target.Row & ":" & Target.Row).Copy wb.Sheets("Done").Range("A" & targetRow)
    End If
End If

End Sub

 

[XQ4585]

Hi, Seems it's a duplicate post.

Meanwhile use below code in Data Sheet of Book1. keep both workbook open.
When you type HOD, the row will be copied in Done sheet of book2.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim targetRow As Integer
Set wb = Workbooks("Book2.xlsx")
targetRow = wb.Sheets("Done").Cells(Rows.Count, 1).End(xlUp).Row + 1
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("E:E")) Is Nothing Then
    If Range("E" & Target.Row) = "HOD" Then
        ActiveSheet.Range(Target.Row & ":" & Target.Row).Copy wb.Sheets("Done").Range("A" & targetRow)
    End If
End If

End Sub

Thanks a lot