macro to transfer cell data to another worksheet

[XQ4585]

i am figuring out vba code to transfer data from one workbook to another workbook, wish someone could help me. Thanks.
Left hand side was Book1 with sheet name Data while right hand side was Book2 with sheet name Done. I wish to move data from Book1 when "confirmed by" show "HOD" and paste to Book2.

 

[Saurabhj]

Hi,

Please use below code in Worksheet Data of Book1.

• Keep both workbook open.
• When you type HOD in Column E of Done sheet that row will be copied to 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

 

[BSALV]

Sub XQ()
     Dim sH1, sH2, LO1, LO2

     Set sH1 = Workbooks("book1.xlsm").Sheets("data")              'your sourcesheet, check names
     Set sH2 = Workbooks("book2.xlsm").Sheets("Done")              'your destinationsheet, check names
     Set LO1 = sH1.Range("A1").ListObject                       'listobject in the source
     Set LO2 = sH2.Range("A1").ListObject                       'listobject in the destination

     With LO1
          .Range.AutoFilter 5, "HOD"                            'filter source on "HOD" in the 5th column
          If .Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then     'at least 1 visible row in the source
               .DataBodyRange.Copy 'copy visible cells
               LO2.Range.Cells(LO2.ListRows.Count + 2, 1).PasteSpecial xlValues
          End If
     End With
End Sub

 

[XQ4585]

Hi,

Please use below code in Worksheet Data of Book1.

• Keep both workbook open.
• When you type HOD in Column E of Done sheet that row will be copied to 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

Thankyou so much

 

[XQ4585]

Sub XQ()
     Dim sH1, sH2, LO1, LO2

     Set sH1 = Workbooks("book1.xlsm").Sheets("data")              'your sourcesheet, check names
     Set sH2 = Workbooks("book2.xlsm").Sheets("Done")              'your destinationsheet, check names
     Set LO1 = sH1.Range("A1").ListObject                       'listobject in the source
     Set LO2 = sH2.Range("A1").ListObject                       'listobject in the destination

     With LO1
          .Range.AutoFilter 5, "HOD"                            'filter source on "HOD" in the 5th column
          If .Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then     'at least 1 visible row in the source
               .DataBodyRange.Copy 'copy visible cells
               LO2.Range.Cells(LO2.ListRows.Count + 2, 1).PasteSpecial xlValues
          End If
     End With
End Sub

Thanks a lot