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
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