View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Ryan H Ryan H is offline
external usenet poster
 
Posts: 489
Default 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