Beginner: Compare cells, if they have same value, then copy the ro

[Steffen Sørdal]

Hi,

I am newbie to VBA, and need help to accomplish:

In a sheet I need to compare the cells in row E (row E is sorted
alphabetically), to see if they have the same value. It can be up to 10 rows
with the same value. (the whole sheet contains <1500 rows)

If they are the same, those rows with samy value in column E shall be copied
to another sheet.
This is just a part of the makros that are running.

As said, I am a newbie, but does this do something?
(Earlier in the makro there is
Dim x
x = 1)

Sheets("Skatteseddel").Select

Dim k
k = 1

If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1

Sheets("Skatteseddel").Select
Rows(x,x+k).Select
Selection.Copy

Can someone please help?

 

[Jacob Skaria]

Check out the below macro

Sub MyMacro()
Dim ws As Worksheet, lngRow As Long, lngStart As Long

Set ws = Sheets("Skatteseddel")
lngStart = 2 'Row where data starts

For lngRow = lngStart + 1 To ws.Cells(Rows.Count, "E").End(xlUp).Row + 1
If ws.Range("E" & lngRow) <> ws.Range("E" & lngRow + 1) Then
ws.Rows(lngStart & ":" & lngRow).Select

'OR
'ws.Rows(lngStart & ":" & lngRow).Copy

lngStart = lngRow + 1
End If
Next

End Sub

 

[Ryan H]

This code should do what you are wanting. I assumed you have a header row in
sheet Skatteseddel and your copy sheet. You will have to name the sheet
where you want the copied rows to go to, I assumed "Sheet2". Just change the
sheet name in the row indicated below with the >>>> next to it. Hope this
helps! If so, let me know, click "YES" below.

Sub CopyRows()

Dim wksSource As Worksheet
Dim wksCopy As Worksheet
Dim LastRow As Long
Dim rw As Long
Dim FirstRow As Long
Dim FinalRow As Long

Set wksSource = Sheets("Skatteseddel")
With wksSource
LastRow = .Cells(Rows.Count, "E").End(xlUp).Row
For rw = 1 To LastRow
If .Cells(rw, "E").Value = .Cells(rw + 1, "E").Value Then
FirstRow = rw
FinalRow = rw
Do Until .Cells(FirstRow, "E").Value <> .Cells(FinalRow,
"E").Value
FinalRow = FinalRow + 1
Loop
.Rows(FirstRow & ":" & FinalRow - 1).Copy _
Destination:=wksCopy.Range("A" &
wksCopy.Cells(Rows.Count, "A").End(xlUp).Row + 1)
rw = FinalRow - 1
End If
Next rw
End With

End Sub