SOLVED

Help with Macro

Copper Contributor
Hi. I'm Boris from Serbia and I need your help!

I want when I put "DA" (on english DA means YES) on the drop-down list (right on the screen) automaticly copy column "Cena" (eng. Price) and "Proizvod" (eng. Product) to my second table on second Sheet (Prodaja/Nabavka) in column "Prodaja/Nabavka" (eng. Sell/Purchase) and "Prihod" (eng. Income).

Means, when I click "DA" column "Proizviod" copy to column "Prodaja/Nabavka" and column "Cena" to "Prihod".

Can I expect your help or you can tell my how can I do that? Thanks for your time. I send you my Workbook in attachment. Thanks for your help! :smiling_face_with_smiling_eyes:
2 Replies
best response confirmed by Boris95 (Copper Contributor)
Solution

@Boris95 

Here is a macro:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim r As Long
    If Not Intersect(Me.Range("K5:K100"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        With Sheet2
            r = 4
            Do
                r = r + 1
            Loop Until .Range("H" & r).Value = ""
            For Each rng In Intersect(Me.Range("K5:K100"), Target)
                .Range("H" & r).Value = rng.Offset(0, -4).Value
                .Range("I" & r).Value = rng.Offset(0, -3).Value
                r = r + 1
            Next rng
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Thanks a lot @Hans Vogelaar This work for me. 

1 best response

Accepted Solutions
best response confirmed by Boris95 (Copper Contributor)
Solution

@Boris95 

Here is a macro:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim r As Long
    If Not Intersect(Me.Range("K5:K100"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        With Sheet2
            r = 4
            Do
                r = r + 1
            Loop Until .Range("H" & r).Value = ""
            For Each rng In Intersect(Me.Range("K5:K100"), Target)
                .Range("H" & r).Value = rng.Offset(0, -4).Value
                .Range("I" & r).Value = rng.Offset(0, -3).Value
                r = r + 1
            Next rng
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

View solution in original post