[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 267
  • Last Modified:

copy specific rows from one tab to another tab with VBA code

I have attached a spread sheet which demonstrates what I need to do which is:

Sheet 1 and Sheet 2 start out with the exact same details.

Sheet2 is updated with ‘New, amended or deleted’ details ad this is highlighted by the user in column ‘N’

I need my macro to:
1]  review sheet 2 against sheet 1 and where any new items are on Sheet 2 put those lines onto a new tab called ‘New’ [assume this tab did not exist only sheets 1 and 2]
2] copy any items from Sheet 2 that have been amended onto a new tab called Amend_Delete

Appreciate any assistance with this
Thanks
NAD.xls
0
Jagwarman
Asked:
Jagwarman
1 Solution
 
Harry LeeCommented:
Use the following macro

Sub ReviewData()
Dim I As Integer, DBWS As Worksheet, WS As Worksheet, NewWS As Worksheet, ADWS As Worksheet
Dim NewI As Integer, ADI As Integer

Sheets.Add.Name = "New"
Sheets.Add.Name = "Amend_Delete"

Set DBWS = Sheets("Sheet1")
Set WS = Sheets("Sheet2")
Set NewWS = Sheets("New")
Set ADWS = Sheets("Amend_Delete")

NewWS.Rows(1).Value = DBWS.Rows(1).Value
ADWS.Rows(1).Value = DBWS.Rows(1).Value

For I = 2 To WS.Cells(Rows.Count, 1).End(xlUp).Row
    If WS.Cells(I, 14) = "" Then
        Else
            If WS.Cells(I, 14) = "New" Then
                NewI = NewWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
                NewWS.Rows(NewI).Value = WS.Rows(I).Value
            Else
                If WS.Cells(I, 14) = "Amended" Then
                    ADI = ADWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    ADWS.Rows(ADI).Value = WS.Rows(I).Value
                Else
                    If WS.Cells(I, 14) = "Deleted" Then
                        ADI = ADWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        ADWS.Rows(ADI).Value = WS.Rows(I).Value
                    End If
                End If
            End If
    End If
Next
NewWS.Cells.Font.Size = 8
ADWS.Cells.Font.Size = 8
End Sub

Open in new window

0
 
JagwarmanAuthor Commented:
Brilliant thanks
0

Featured Post

Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now