Copying specific data from one worksheet to another (Excel97/VBA)

[letaylor]

Hi everyone,

I currently use the autofilter to copy data from my main data worksheet to 6 other worksheets in my workbook based on 2 autofilter criteria. This is done as part of my code in VBA.

This doesn't seem like it is the most efficient and fastest way to do this (The code runs really slow at that point)

I would like to know how to do this a better way. I would think I would have to loop though my main worksheet looking for a specific name (John Doe) and the secondary criteria (Forecast) and each time it finds that criteria in the line it would copy that line and paste in the appropriately named worksheet (Already Created with John Doe's Name)

There are a total of 3 names and 2 types of secondary criteria, for a total of 6 worksheets that the data get's copied into.

I am not sure how to do this, could someone point me in the right direction?

Thanks!

 

[letaylor]

I got it with some help on another Forum...

I added the criteria I need to each of these sheets via another part of code. Then this get's run..

Sub FiltertoSheets()

Sheets("Adams Pipe&quot.Select
Dim ws As Worksheet
For Each ws In Worksheets(Array("Adams Pipe", "Adams Fcst", "Jones Pipe", "Jones Fcst", "Doe Pipe", "Doe Fcst&quot)
ws.Activate
With ActiveSheet

Sheets("FDD Consolidator&quot.Columns("A:AA&quot.AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Range("A1:B2&quot, CopyToRange:=Range("A4&quot, _
Unique:=False

End With
Next ws
End Sub

Worked like a charm..

 

[caniwi]

Look at this before considering a loop.

http://www.ozgrid.com/VBA/MiscVBA.htm

Place the text "Find Me" into cell IV65336 and run this code:

Sub NoLoop()
Cells.Find(What:="Find Me", After:=[A1], LookIn:=xlFormulas, _
		LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
		MatchCase:=False).Activate
End Sub

Now if you have at least 5 minutes to spare, try this code:

Sub WithLoop()
Dim rCell As Range

	For Each rCell In Cells
		If rCell.Value = "Find Me" Then
			rCell.Activate
			Exit For
		End If
	Next rCell
End Sub