How can I make this simpler?

[Sethaholic]

Hi,

I have 2 workbooks. In the first workbook, I have several worksheets sorted by last name. In the second workbook, I have 4 columns: name, account#, description, end date.

I am trying to autofilter it so that I can copy the respective information from workbook2("text") to workbook1("SNAPSHOT - PWC") through the following criteria: contains the name of the sheet and is end date is greater than 20040630 or equals to 0. Here is what I have so far, and it works. But is there a way to vba code this so that it will go through each worksheet in a loop of some sort so that I don't have to keep rewriting the same code and just changing the names on it? If this is confusing please let me know, but I think the coding I provided below should be self-explanatory in what I am trying to accomplish.


Sub GetAccounts()

Windows("Text.xls").Activate
Sheets("Sheet3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="=*altemus*"
Selection.AutoFilter Field:=4, Criteria1:=">20040630", Operator:=xlOr, _
Criteria2:="0"
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Windows("SNAPSHOT-PWC.xls").Activate
Sheets("Altemus").Select
Range("A34").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows("Text.xls").Activate
Sheets("Sheet3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="=*anderson*", Operator:=xlAnd
Selection.AutoFilter Field:=4, Criteria1:=">20040630", Operator:=xlOr, _
Criteria2:="0"
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Windows("SNAPSHOT-PWC.xls").Activate
Sheets("Anderson").Select
Range("A34").Select
Selection.PasteSpecial Paste:=xlAll

Windows("Text.xls").Activate
Sheets("Sheet3").Select
Selection.AutoFilter Field:=1, Criteria1:="=*bartlik*"
Selection.AutoFilter Field:=4, Criteria1:=">20040630", Operator:=xlOr, _
Criteria2:="=0"
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Windows("SNAPSHOT-PWC.xls").Activate
Sheets("Bartlik").Select
Range("A34").Select
Selection.PasteSpecial Paste:=xlAll

etc, etc.

I can keep going with this, but I am sure there is a much simpler method which requires less coding, since I have so many different sheets. Please help!! Thanks in advance.

[Tom Ogilvy]

Sub GetAccounts()

v = Array("altemus","bartlik","hortimus","swansen")
for i = lbound(v) to ubound(v)
Windows("Text.xls").Activate
Sheets("Sheet3").Select
Selection.AutoFilter
' alteration here
Selection.AutoFilter Field:=1, Criteria1:="=*" & v(i) & "*"
Selection.AutoFilter Field:=4, Criteria1:=">20040630",
Operator:=xlOr, _
Criteria2:="0"
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Windows("SNAPSHOT-PWC.xls").Activate
' alteration made here
Sheets(v(i)).Select
Range("A34").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Loop
End Sub

--
Regards,
Tom Ogilvy

"Sethaholic" <[email protected]> wrote
in message news:[email protected]...
>
> Hi,
>
> I have 2 workbooks. In the first workbook, I have several worksheets
> sorted by last name. In the second workbook, I have 4 columns: name,
> account#, description, end date.
>
> I am trying to autofilter it so that I can copy the respective
> information from workbook2("text") to workbook1("SNAPSHOT - PWC")
> through the following criteria: contains the name of the sheet and is
> end date is greater than 20040630 or equals to 0. Here is what I have
> so far, and it works. But is there a way to vba code this so that it
> will go through each worksheet in a loop of some sort so that I don't
> have to keep rewriting the same code and just changing the names on it?
> If this is confusing please let me know, but I think the coding I
> provided below should be self-explanatory in what I am trying to
> accomplish.
>
>
> Sub GetAccounts()
>
> Windows("Text.xls").Activate
> Sheets("Sheet3").Select
> Selection.AutoFilter
> Selection.AutoFilter Field:=1, Criteria1:="=*altemus*"
> Selection.AutoFilter Field:=4, Criteria1:=">20040630",
> Operator:=xlOr, _
> Criteria2:="0"
> Range("B1").Select
> Range(Selection, Selection.End(xlToRight)).Select
> Range(Selection, Selection.End(xlDown)).Select
> Selection.Copy
> Range("A1").Select
> Windows("SNAPSHOT-PWC.xls").Activate
> Sheets("Altemus").Select
> Range("A34").Select
> Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
> SkipBlanks:= _
> False, Transpose:=False
>
> Windows("Text.xls").Activate
> Sheets("Sheet3").Select
> Selection.AutoFilter
> Selection.AutoFilter Field:=1, Criteria1:="=*anderson*",
> Operator:=xlAnd
> Selection.AutoFilter Field:=4, Criteria1:=">20040630",
> Operator:=xlOr, _
> Criteria2:="0"
> Range("B1").Select
> Range(Selection, Selection.End(xlToRight)).Select
> Range(Selection, Selection.End(xlDown)).Select
> Selection.Copy
> Range("A1").Select
> Windows("SNAPSHOT-PWC.xls").Activate
> Sheets("Anderson").Select
> Range("A34").Select
> Selection.PasteSpecial Paste:=xlAll
>
> Windows("Text.xls").Activate
> Sheets("Sheet3").Select
> Selection.AutoFilter Field:=1, Criteria1:="=*bartlik*"
> Selection.AutoFilter Field:=4, Criteria1:=">20040630",
> Operator:=xlOr, _
> Criteria2:="=0"
> Range("B1").Select
> Range(Selection, Selection.End(xlToRight)).Select
> Range(Selection, Selection.End(xlDown)).Select
> Selection.Copy
> Range("A1").Select
> Windows("SNAPSHOT-PWC.xls").Activate
> Sheets("Bartlik").Select
> Range("A34").Select
> Selection.PasteSpecial Paste:=xlAll
>
> etc, etc.
>
> I can keep going with this, but I am sure there is a much simpler
> method which requires less coding, since I have so many different
> sheets. Please help!! Thanks in advance.
>
>
> --
> Sethaholic
> ------------------------------------------------------------------------
> Sethaholic's Profile:
http://www.excelforum.com/member.php...o&userid=25113
> View this thread: http://www.excelforum.com/showthread...hreadid=386864
>

[Sethaholic]

Thanks for your response, Tom, but I get an error: Loop without Do.

How can I fix this?

Thanks

[Tom Ogilvy]

Loop
should be

Next

My typo.

--
Regards,
Tom Ogilvy

"Sethaholic" <[email protected]> wrote
in message news:[email protected]...
>
> Thanks for your response, Tom, but I get an error: Loop without Do.
>
> How can I fix this?
>
> Thanks
>
>
> --
> Sethaholic
> ------------------------------------------------------------------------
> Sethaholic's Profile:
http://www.excelforum.com/member.php...o&userid=25113
> View this thread: http://www.excelforum.com/showthread...hreadid=386864
>