First off I am just learning VBA.
The code below is in a module for a workbook. What it does is send each individual row
of my database to it's own worksheet.(creates one if none exsist).
The problem is that it replaces the old data that is on the worksheets with the new data
every time it is run.(ie. I never have more than the header and ONE row of data)
What I need it to do is add a new row of data every time the macro is run.
From what I understand when I call AdvancedFilter(at least the way I have it now)
it is defaulted to replacing the existing data.
The last row code must only apply to the sheets I am sending the data to.
Thanks in advance for any help!
The code below is in a module for a workbook. What it does is send each individual row
of my database to it's own worksheet.(creates one if none exsist).
The problem is that it replaces the old data that is on the worksheets with the new data
every time it is run.(ie. I never have more than the header and ONE row of data)
What I need it to do is add a new row of data every time the macro is run.
From what I understand when I call AdvancedFilter(at least the way I have it now)
it is defaulted to replacing the existing data.
The last row code must only apply to the sheets I am sending the data to.
Thanks in advance for any help!
Code:
Option Explicit
Sub FilterStocks()
Dim c As Range
Dim ws As Worksheet
For Each c In Range("STOCKLIST")
If WksExists(c.Value) = False Then
Set ws = Sheets.Add
ws.Name = c.Value
ws.Move After:=Sheets(Sheets.Count)
Sheets(Range("STOCKLIST").Cells(1, 1).Value) _
.Rows("1:1").Copy Destination:=ws.Rows("1:1")
End If
Sheets("CRIT").Range("D2").Value = c.Value
Sheets("DATA").Range("DATABASE").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("CRIT").Range("D1:D2"), _
CopyToRange:=Sheets(c.Value).Range("A1:H1"), _
Unique:=False
Next
MsgBox "Data has been sent"
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
