Thanks for this Jim, I hope you had a nice weekend

This works great, just what I wanted, however I'm having trouble changing
the sum figure on the tab name to pick up sum of column G on the new sundries
sheet not the original sheet. I dont want to mess the whole thing up!!

strSheetName = "Sundries - " & Round(Application.Sum(Columns("G")), 2)

One last bit of help would be brilliant! Thanks, Mel :-)


"Jim Thomlinson" wrote:

Try this...

Sub CopySundries()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngPaste As Range
Dim strFirstAddress As String
Dim strSheetName As String
Dim wksPaste As Worksheet

strSheetName = "Sundires - " & Round(Application.Sum(Columns("G")), 2)
If SheetExists(strSheetName) Then
MsgBox "Sheet " & strSheetName & " already exists. Please " & _
"delete or rename."
Exit Sub
End If

Set rngToSearch = ActiveSheet.Columns("I")
Set rngFound = rngToSearch.Find(What:="S", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "There are no items to move."
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress

Set wksPaste = Worksheets.Add(After:=ActiveSheet)
With wksPaste
wksPaste.Name = strSheetName
Set rngPaste = wksPaste.Range("A2")
End With
rngFoundAll.EntireRow.Copy Destination:=rngPaste
End If
End Sub

Public Function SheetExists(SName As String, _
Optional ByVal Wb As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If Wb Is Nothing Then Set Wb = ThisWorkbook
SheetExists = CBool(Len(Wb.Sheets(SName).Name))
End Function
--
HTH...

Jim Thomlinson


"Meltad" wrote:

BRILL! Thanks Jim,

I removed the delete line, good thinking!
A couple of things...

1. The code worked once I'd added the Sundries sheet in manually (how do I
add the tab automatically with code?)

2. How do I name that tab 'Sundries - X' where X would be the autosum value
of column G??

Thanks for that code.




"Jim Thomlinson" wrote:

Here is some code to move the items.

Sub MoveStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngPaste As Range
Dim strFirstAddress As String

Set rngPaste = Sheets("Sundries").Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
Set rngToSearch = ActiveSheet.Columns("I")
Set rngFound = rngToSearch.Find(What:="S", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "There are no items to move."
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress

rngFoundAll.EntireRow.Copy Destination:=rngPaste
rngFoundAll.EntireRow.Delete 'Optional to Delete
End If
End Sub

It moves the data. I personally would be more inclined to not delete the
sundry items from the source data sheet but that is up to you...
--
HTH...

Jim Thomlinson


"Meltad" wrote:

Hi Jim,

I'd prefer code as I'm writing a macro to help users cut down on manual
spreadsheet fiddling! This step is just one in a long line of many cut and
paste actions they do to get a couple of figures at the end.

Thinking about it actually...
I could just use subtotals instead...

Do you know how I subtotal using code?

Thanks :-)


"Jim Thomlinson" wrote:

Why use code? How about Pivot Tables or Filters? It can be done in code but
the end result will be the same...
--
HTH...

Jim Thomlinson


"Meltad" wrote:

Hi,

I've searched for similar situations to mine in the discussion pages but
can't piece together all the answers properly to get what I need!

I want to select and cut all rows from my worksheet where column I = "S"
then paste these into a seperate tab (and name this 'Sundries' if possible)???

Also, how do i use code to subtotal different values within the worksheet?

Thanks, Mel