SOLVED

Need to save data in other sheet

%3CLINGO-SUB%20id%3D%22lingo-sub-2178763%22%20slang%3D%22en-US%22%3ENeed%20to%20save%20data%20in%20other%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2178763%22%20slang%3D%22en-US%22%3E%3CP%3EHi%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20have%20this%20code%20which%20helps%20me%20in%20saving%20data%20for%20two%20cells%20in%20different%20sheet.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPrivate%20Sub%20Worksheet_Change(ByVal%20Target%20As%20Range)%3C%2FP%3E%3CP%3EIf%20Target.Address%20%3D%20Range(%22M2%22).Address%20Then%3CBR%20%2F%3EDim%20intLastRow%20As%20Long%3CBR%20%2F%3EintLastRow%20%3D%20Sheet2.Cells(Sheet2.Rows.Count%2C%20%22A%22).End(xlUp).Row%3CBR%20%2F%3ESheet2.Cells(intLastRow%20%2B%201%2C%20%22B%22)%20%3D%20Target.Value%3C%2FP%3E%3CP%3EElseIf%20Target.Address%20%3D%20Range(%22M3%22).Address%20Then%3CBR%20%2F%3EDim%20intLastRow2%20As%20Long%3CBR%20%2F%3EintLastRow2%20%3D%20Sheet2.Cells(Sheet2.Rows.Count%2C%20%22B%22).End(xlUp).Row%3CBR%20%2F%3ESheet2.Cells(intLastRow2%20%2B%201%2C%20%22B%22)%20%3D%20Target.Value%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3EEnd%20Sub%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EWith%20this%20code%20working%20i%20want%20to%20save%20the%20data%20for%20the%20range%20P2%3AP7%20and%20AC2%3AAC7%20in%20different%20sheet.%20They%20should%20be%20saved%20in%20different%20columns%20(Like%20P2%20data%20goes%20to%20C%2C%20P3%20data%20goes%20to%20D)%20so%20that%20i%20can%20do%20comparison%20later.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThanks%20in%20Advance.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2178763%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3Edeveloper%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2181632%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20to%20save%20data%20in%20other%20sheet%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2181632%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F974672%22%20target%3D%22_blank%22%3E%40tusharkaushik%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3ETry%3C%2FP%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3EPrivate%20Sub%20Worksheet_Change(ByVal%20Target%20As%20Range)%0A%20%20%20%20Dim%20rng%20As%20Range%0A%20%20%20%20Dim%20c%20As%20Long%0A%20%20%20%20Dim%20r%20As%20Long%0A%20%20%20%20If%20Not%20Intersect(Range(%22M2%3AM3%2CP2%3AP7%2CAC2%3AAC7%22)%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20For%20Each%20rng%20In%20Intersect(Range(%22M2%3AM3%2CP2%3AP7%2CAC2%3AAC7%22)%2C%20Target)%0A%20%20%20%20%20%20%20%20%20%20%20%20c%20%3D%20rng.Row%20-%201%20-%202%20*%20(rng.Column%20%3D%2016)%20-%208%20*%20(rng.Column%20%3D%2029)%0A%20%20%20%20%20%20%20%20%20%20%20%20r%20%3D%20Sheet2.Cells(Sheet2.Rows.Count%2C%20c).End(xlUp).Row%0A%20%20%20%20%20%20%20%20%20%20%20%20If%20rng.Value%20%26lt%3B%26gt%3B%20Sheet2.Cells(r%2C%20c).Value%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Sheet2.Cells(r%20%2B%201%2C%20c).Value%20%3D%20rng.Value%0A%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20Next%20rng%0A%20%20%20%20End%20If%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E
Occasional Contributor

Hi,

 

I have this code which helps me in saving data for two cells in different sheet.

 

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = Range("M2").Address Then
Dim intLastRow As Long
intLastRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
Sheet2.Cells(intLastRow + 1, "B") = Target.Value

ElseIf Target.Address = Range("M3").Address Then
Dim intLastRow2 As Long
intLastRow2 = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row
Sheet2.Cells(intLastRow2 + 1, "B") = Target.Value
End If
End Sub

 

With this code working i want to save the data for the range P2:P7 and AC2:AC7 in different sheet. They should be saved in different columns (Like P2 data goes to C, P3 data goes to D) so that i can do comparison later.

 

Thanks in Advance.

1 Reply
best response confirmed by tusharkaushik (Occasional Contributor)
Solution

@tusharkaushik 

Try

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim c As Long
    Dim r As Long
    If Not Intersect(Range("M2:M3,P2:P7,AC2:AC7"), Target) Is Nothing Then
        For Each rng In Intersect(Range("M2:M3,P2:P7,AC2:AC7"), Target)
            c = rng.Row - 1 - 2 * (rng.Column = 16) - 8 * (rng.Column = 29)
            r = Sheet2.Cells(Sheet2.Rows.Count, c).End(xlUp).Row
            If rng.Value <> Sheet2.Cells(r, c).Value Then
                Sheet2.Cells(r + 1, c).Value = rng.Value
            End If
        Next rng
    End If
End Sub