VBA macro needed to filter, cut, paste rows into corresponding workbooks

[michrome23]

Spreadsheet Used For: Logging Surveillance Video


Criteria:

Clients 65+

Cameras 1,000+

Camera operators 15+


Situation:

Each shift has 4-5 camera operators logging notes in one spreadsheet


Problem:

We would like to be able to consolidate the daily notes into individual workbooks per client. So that each client would have their own file and the daily notes would be deposited in their automatically. (We have 65+ clients and quickly growing, so tabs created for each client is undesirable).


Solution Needed:


1) A macro that takes cuts filtered rows based in column A:A (Range containing Client Names) to another workbook based on names in column A:A (Workbook is Saved As Clients Name)


2) Then automatically update each workbook (Named after each client) and insert the new current days notes above the previously days row.


Specific Example:


1) Macro that cuts and pastes the daily notes recorded for AAA Apartments

(in column A:A) to a workbook named AAA Apartments, then for City of Dallas, then, Disney Land, Ect.


2) Then the next day's notes would be done the same; only inserting the newest cut rows above the previous days pasted notes


Link to Template:

http://www.mediafire.com/file/lavgaiaikpdgaqf/Surveillance%20Notes%2010_27_2010.xlsm

 

[Hui]

Michrome23,

You probably should email Chandoo directly at http://chandoo.org/wp/about/ and ask for consulting rates to develop such a system to do what you want, or Daniel at ExcelHero.com http://www.excelhero.com/contact/contact.html

 

[michrome23]

Thank you Sir!

 

[ds_murthy]

I am trying to filter, cut and paste data into a new sheet with the same workbook based on multiple criteria.

I am able to record a macro to filter the data based on my criteria and copy and paste is successfully, however I am not able to remove it from the master list. Can someone please help me with this. Below is my code:


Sub GRN_FIL()

'

' GRN_FIL Macro

'


'

Selection.AutoFilter

ActiveSheet.Range("$A$1:$I$5025").AutoFilter Field:=5, Criteria1:= _

"Ennore (H-Engine)"

ActiveSheet.Range("$A$1:$I$5025").AutoFilter Field:=7, Criteria1:="<>*0*"

ActiveSheet.Range("$A$1:$I$5025").AutoFilter Field:=9, Criteria1:="0"

ActiveWindow.SmallScroll Down:=-36

ActiveCell.Offset(32, 0).Range("A1").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Cut

Sheets("H Engine").Select


'first, select cell in the first row of that column, like A1, K1, etc

Range("A1").Select


'move to the last cell with data

Selection.End(xlDown).Select


'move to one row below it

ActiveCell.Offset(1, 0).Select


'paste the copied data in there

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False


'ActiveCell.Offset(1, 0).Range("A1").Select

'ActiveSheet.Paste

'ActiveCell.Offset(-1, 0).Range("A1").Select

'Sheets("Invoice").Select

'ActiveCell.Offset(-32, 0).Range("A1").Select

'Application.CutCopyMode = False


ActiveSheet.ShowAllData

End Sub

 

[Hui]

ds_murthy


I can't cut the records and so I have Copied, Cleared and re-sorted the records

I am sure there is a better way but this works

[pre]

Sub GRN_FIL()
'
' GRN_FIL Macro
'
Dim rng As Range
Dim sht1 As String, sht2 As String

sht1 = "Sheet1" ' Change to suit
sht2 = "H Engine" ' Change to suit

Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$5025").AutoFilter Field:=5, Criteria1:="Ennore (H-Engine)"
ActiveSheet.Range("$A$1:$I$5025").AutoFilter Field:=7, Criteria1:="<>*0*"
ActiveSheet.Range("$A$1:$I$5025").AutoFilter Field:=9, Criteria1:="0"

Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy Destination:=Worksheets(sht2).Range("A1").End(xlDown).Offset(1, 0)
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).ClearContents

Sheets(sht1).Select
ActiveSheet.ShowAllData

ActiveWorkbook.Worksheets(sht1).AutoFilter.Sort.SortFields.Add Key:=Range _
("A1:A5025"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets(sht1).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sheets(sht2).Select

End Sub

[/pre]