How to make this code smaller

C

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
 
S

Stefi

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

Regards,
Stefi

„Carlos†ezt írta:
 
D

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
 
P

p45cal

Untested:For Each c In sh1.Range("A1:A" & lr2)
If c.Value = "H1" Or c.Value = "H2" Or c.Value = "H3" Then
lr1 = sh2.Range("A" & Rows.Count).End(xlUp).Row
c.EntireRow.Cut Sheets("UK").Rows(lr1 + 1)
End If
Next
or:For Each c In sh1.Range("A1:A" & lr2)
If c.Value = "H1" Or c.Value = "H2" Or c.Value = "H3" The
c.EntireRow.Cut Sheets("UK").Rows(sh2.Range("A"
Rows.Count).End(xlUp).Row + 1)
Next
Result won't necessarily be in the same order.
In both snippets I've tried shortening you cut/paste - again untested
 
C

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
 
D

Don Guillett

NOT the most efficient way but whatever makes you happy.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Carlos said:
Thanks to all for replying.

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

Many thanks
Carl
 
C

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

Don Guillett said:
NOT the most efficient way but whatever makes you happy.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Carlos said:
Thanks to all for replying.

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

Many thanks
Carl
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top