PDA

View Full Version : Solved: Search different sheets



Pinokkio
05-17-2010, 12:44 PM
Hi,
With this macro I can search on one sheet "Monday".
Is it posible to search on the other days of the week?

I try to change the line in to
wsData As Worksheets
Set wsData = Sheets("Monday" , "Tuesday")
But this don't work?




Sub TabsKopie()
Dim dic As Object, x, y, i As Long, r As Range
Dim WS As Worksheet, wsData As Worksheet

Set dic = CreateObject("Scripting.Dictionary")
Set wsData = Sheets("Monday")
With wsData
For Each r In .Range("c3", .Range("c65536").End(xlUp))

If Not IsEmpty(r) Then
If Not dic.exists(r.Value) Then
dic.Add r.Value, r.Row & ":" & r.Row
Else
dic(r.Value) = dic(r.Value) & "," & r.Row & ":" & r.Row
End If
End If

Next
End With
x = dic.keys: y = dic.items

For i = LBound(x) To UBound(x)
On Error Resume Next
Set WS = Sheets(CStr(x(i)))
On Error GoTo 0
If WS Is Nothing Then
Set WS = Sheets.Add(after:=Sheets(Sheets.Count))
WS.Name = x(i)
wsData.Range(y(i)).EntireRow.Copy _
WS.Range("a65536").End(xlUp).Offset(1)
End If
Set WS = Nothing

Next

Sheets("Monday").Select
Application.DisplayAlerts = True
End Sub




I hope that someone can give me idea to me. Thanks

GTO
05-17-2010, 03:27 PM
Sub TabsKopie_2()
Dim dic As Object, x, y, i As Long, r As Range
Dim WS As Worksheet, wsData As Worksheet

For Each WS In Worksheets(Array("Maandag", "Dinsdag", "Woensdag", _
"Donderdag", "Vrijdag", "Zaterdag", _
"Zondag"))

Set dic = CreateObject("Scripting.Dictionary")

Set wsData = WS 'Sheets("Monday")

With wsData
For Each r In .Range("c3", "C" & Application.Max(.Range("c65536").End(xlUp).Row, 3))

If Not IsEmpty(r) Then
If Not dic.exists(r.Value) Then
dic.Add r.Value, r.Row & ":" & r.Row
Else
dic(r.Value) = dic(r.Value) & "," & r.Row & ":" & r.Row
End If
End If
Next
End With

Set WS = Nothing

x = dic.keys: y = dic.items

For i = LBound(x) To UBound(x)

On Error Resume Next
Set WS = Sheets(CStr(x(i)))
On Error GoTo 0

If WS Is Nothing Then
Set WS = Sheets.Add(after:=Sheets(Sheets.Count))
WS.Name = x(i)
End If

wsData.Range(y(i)).EntireRow.Copy _
WS.Range("C65536").End(xlUp).Offset(1, -2)

Set WS = Nothing
Next

Set dic = Nothing
Next

Sheets("Maandag").Select
Application.DisplayAlerts = True
End Sub

GTO
05-17-2010, 03:36 PM
ACK!

I just realized that there's a .DisplayAlerts in there. If you have this shut off someplace prior, it should not be.

Pinokkio
05-18-2010, 11:40 AM
Many thanks, GTO.

P.