Beginner: Compare cells, if they have same value, then copy the ro
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")
Set wksCopy = Sheets("Sheet2")
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
--
Cheers,
Ryan
"Steffen Sørdal" wrote:
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?
--
Regards,
Steffen
--
Regards,
Steffen
|