Add automatically new data to another sheet

[MasmaAbdulhamidli]

Hi. I have two sheets that they are connecting each other. Some columns in Sheet 1 are same in Sheet 2. But paste link method doesn't work because when I want to add new row or delete row in Sheet 1 it doesn't appear in Sheet 2. I need another method to do that. I have many data in rows but i need some columns data to adding automatically in Sheet 2. How can I do that? I want to work with only Sheet 1, when I open Sheet 2 I want to see necessary data in there

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[MasmaAbdulhamidli]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Book1.xlsx | Powered by Box

app.box.com

I created example

 

[mumps]

There are many factors to consider such as how you are adding and deleting rows. I am assuming that to add or delete a row, you right click on the row number at the left of your sheet and then select "Insert" or "Delete" from the pop up menu. Try this macro and see how it works out. Copy and paste the macro into the worksheet code module. Do the following: right click the tab name for your sheet "Umumi Siyahi" and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter data in any cell in columns A:H and press the ENTER key. Try inserting and adding a row as well.

Dim lRow As Long, No As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set No = Range("A" & Target.Row)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:H")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim lRow2 As Long, fnd As Range, header As Range, desWS As Worksheet
    lRow2 = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set desWS = Sheets("Ücret Verisi")
    If lRow = lRow2 Then
        Select Case Target.Column
            Case 2 To 8
                Set fnd = desWS.Range("A:A").Find(No, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Set header = desWS.Rows(1).Find(Cells(2, Target.Column), LookIn:=xlValues, lookat:=xlWhole)
                    desWS.Cells(fnd.Row, header.Column) = Target
                End If
            Case Is = 1
                If Target.Row > lRow2 Then
                    desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = Target
                Else
                    Set fnd = desWS.Range("A:A").Find(No.Offset(-1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        desWS.Range("A" & fnd.Row + 1) = Target
                    End If
                End If
        End Select
    Else
        If Range("A" & Target.Row) = "" Then
            Set fnd = desWS.Range("A:A").Find(No, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                desWS.Range("A" & fnd.Row).EntireRow.Insert
            End If
        Else
            Set fnd = desWS.Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                desWS.Rows(fnd.Row - 1).Delete
            End If
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[MasmaAbdulhamidli]

There are many factors to consider such as how you are adding and deleting rows. I am assuming that to add or delete a row, you right click on the row number at the left of your sheet and then select "Insert" or "Delete" from the pop up menu. Try this macro and see how it works out. Copy and paste the macro into the worksheet code module. Do the following: right click the tab name for your sheet "Umumi Siyahi" and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter data in any cell in columns A:H and press the ENTER key. Try inserting and adding a row as well.

Dim lRow As Long, No As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set No = Range("A" & Target.Row)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:H")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim lRow2 As Long, fnd As Range, header As Range, desWS As Worksheet
    lRow2 = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set desWS = Sheets("Ücret Verisi")
    If lRow = lRow2 Then
        Select Case Target.Column
            Case 2 To 8
                Set fnd = desWS.Range("A:A").Find(No, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Set header = desWS.Rows(1).Find(Cells(2, Target.Column), LookIn:=xlValues, lookat:=xlWhole)
                    desWS.Cells(fnd.Row, header.Column) = Target
                End If
            Case Is = 1
                If Target.Row > lRow2 Then
                    desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = Target
                Else
                    Set fnd = desWS.Range("A:A").Find(No.Offset(-1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        desWS.Range("A" & fnd.Row + 1) = Target
                    End If
                End If
        End Select
    Else
        If Range("A" & Target.Row) = "" Then
            Set fnd = desWS.Range("A:A").Find(No, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                desWS.Range("A" & fnd.Row).EntireRow.Insert
            End If
        Else
            Set fnd = desWS.Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                desWS.Rows(fnd.Row - 1).Delete
            End If
        End If
    End If
    Application.ScreenUpdating = True
End Sub

Thank you very much. It worked but may we expand it to "A:L"? And also when I want to add new data after last row (I mean I have new employees also and I will add them below too.) it doesn't appear on second sheet. May you do that?

 

[mumps]

may we expand it to "A:L"

Change

If Intersect(Target, Range("A:H")) Is Nothing Then Exit Sub

to

If Intersect(Target, Range("A:L")) Is Nothing Then Exit Sub

If you do this, the macro won't work properly. The headers in columns K and L in the "Umumi Siyahi" sheet are "Score of Grades" and "Performance". These two headers don't exist in the "Ücret Verisi" sheet.

 

[MasmaAbdulhamidli]

Change

If Intersect(Target, Range("A:H")) Is Nothing Then Exit Sub

to

If Intersect(Target, Range("A:L")) Is Nothing Then Exit Sub

If you do this, the macro won't work properly. The headers in columns K and L in the "Umumi Siyahi" sheet are "Score of Grades" and "Performance". These two headers don't exist in the "Ücret Verisi" sheet.

You are perfect! Thank you very much. I changed headers in Ücret Verisi sheet and it worked. Thank you!

 

[mumps]

You are very welcome.

 

[MasmaAbdulhamidli]

Change

If Intersect(Target, Range("A:H")) Is Nothing Then Exit Sub

to

If Intersect(Target, Range("A:L")) Is Nothing Then Exit Sub

If you do this, the macro won't work properly. The headers in columns K and L in the "Umumi Siyahi" sheet are "Score of Grades" and "Performance". These two headers don't exist in the "Ücret Verisi" sheet.