简体   繁体   中英

Need a macro to copy specific cells from a row in one worksheet to a specific cells in another worksheet base upon a data in the cell

I am working on a workbook for my business.

行程记录

Would like to get a Macro going to copy data from a few cells in a row (cell through C to G) of one worksheet to another worksheet row (cells A,B,C,F,G).

The catch is, they need to be only transferred if D column has data entered.

司机报销

I'm unable to properly use code that Alex P wrote for a somewhat similar problem:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nextRow As Long
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        If VBA.IsDate(Target) Then
            With Worksheets("Sheet2")
                nextRow = IIf(VBA.IsEmpty(.Range("A1048576").End(xlUp)), 1, .Range("A1048576").End(xlUp).Row + 1)
                .Range("A" & nextRow) = Target.Offset(0, -3)
                .Range("B" & nextRow) = Target.Offset(0, -1)
                .Range("C" & nextRow) = Target
            End With
        End If
    End If
End Sub

Try this. I got this worksheet:
工作表1
sheet1

表2
sheet 2

Applying the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextRow As Long
If Not Intersect(Target, Range("D:D")) Is Nothing Then
    If Not VBA.IsEmpty(Target) Or VBA.IsNull(Target) Then
        With Worksheets("Sheet2")
            nextRow = IIf(VBA.IsEmpty(.Range("B1048576").End(xlUp)), 1, .Range("B1048576").End(xlUp).Row + 1)
            .Range("A" & nextRow) = Target.Offset(0, -1)
            .Range("B" & nextRow) = Target
            .Range("C" & nextRow) = Target.Offset(0, 1)
            .Range("F" & nextRow) = Target.Offset(0, 2)
            .Range("G" & nextRow) = Target.Offset(0, 3)
        End With
    End If
End If
End Sub


Try enter new line at sheet 1
在此处输入图片说明
Result at sheet 2
在此处输入图片说明

Something you need take note is : make sure column D at sheet 1 is the last item to be entered, if you enter it first, and empty row will be copied.

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM