How can I make this simpler?

  • Thread starter Thread starter Sethaholic
  • Start date Start date
S

Sethaholic

Hi,

I have 2 workbooks. In the first workbook, I have several worksheet
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 respectiv
information from workbook2("text") to workbook1("SNAPSHOT - PWC"
through the following criteria: contains the name of the sheet and i
end date is greater than 20040630 or equals to 0. Here is what I hav
so far, and it works. But is there a way to vba code this so that i
will go through each worksheet in a loop of some sort so that I don'
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
provided below should be self-explanatory in what I am trying t
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 simple
method which requires less coding, since I have so many differen
sheets. Please help!! Thanks in advance
 
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
 
Thanks for your response, Tom, but I get an error: Loop without Do.

How can I fix this?

Thank
 
Back
Top