How to make this code smaller

[Carlos]

Hi,

I've got this which works fine.

Set sh1 = ActiveWorkbook.Sheets("Data")
Set sh2 = ActiveWorkbook.Sheets("UK")

'H1
For Each c In sh1.Range("A1:A" & lr2)
If c.Value = "H1" Then
lr1 = sh2.Range("A" & Rows.Count).End(xlUp).Row
c.EntireRow.Cut
Sheets("UK").Select
Rows(lr1 + 1).Select
ActiveSheet.Paste
End If
Next
'H2
For Each c In sh1.Range("A1:A" & lr2)
If c.Value = "H2" Then
lr1 = sh2.Range("A" & Rows.Count).End(xlUp).Row
c.EntireRow.Cut
Sheets("UK").Select
Rows(lr1 + 1).Select
ActiveSheet.Paste
End If
Next
'H3
For Each c In sh1.Range("A1:A" & lr2)
If c.Value = "H3" Then
lr1 = sh2.Range("A" & Rows.Count).End(xlUp).Row
c.EntireRow.Cut
Sheets("UK").Select
Rows(lr1 + 1).Select
ActiveSheet.Paste
End If
Next


But as I'm looking at the same data in Sh1. Can this be made shorter by some
sort of Or here If c.Value = "H1" Then

Something like if c.Value = "H1","H2","H3" then?

Thanks
Carl

 

[Stefi]

If c.Value = "H1" Or c.Value = "H2" Or c.Value = "H3" Then

Regards,
Stefi

„Carlos†ezt írta:

 

[Don Guillett]

Sub cutdatatoothersheet()
Set ds = Sheets("sheet1")
Set ss = Sheets("sheet6")
With ds
For i = 1 To ss.Cells(Rows.Count, 1).End(xlUp).Row
dlr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If UCase(ss.Cells(i, 1)) = "H1" Or _
UCase(ss.Cells(i, 1)) = "H2" Or _
UCase(ss.Cells(i, 1)) = "H3" Then
ss.Rows(i).Cut .Cells(dlr, 1)
ss.Rows(i).Delete
End If
Next i
End With
End Sub

 

[Carlos]

Thanks to all for replying.

Stefi's worked first time and tidied it up to where I needed it to be.

Many thanks
Carl

 

[Don Guillett]

NOT the most efficient way but whatever makes you happy.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

Thanks to all for replying.

Stefi's worked first time and tidied it up to where I needed it to be.

Many thanks
Carl

 

[Carlos]

I'm sure it's not as it started with my code..

Will come back and took a look at your coding when I've got more time and
knowledge to understand it.

Thanks very much for your input.

Still on a very stiff learning curve.

Carl

NOT the most efficient way but whatever makes you happy.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

Thanks to all for replying.

Stefi's worked first time and tidied it up to where I needed it to be.

Many thanks
Carl