Hey,
I'm afraid it's not working well.
I have 2 sheets, in each sheet I want to do the same thing (as mention before) and filter by the same name in both sheets, than move those 2 sheets to another workbook and save it in that name. and than loop for all.
I tried to wright something but it's not working since i'm a junior in VBA :/
Can you please have a look or propose something else?
appricate it a lot !
Sub test()
Dim dic As Object, rng As Range, wks As Worksheet, mypath As String, x As Long
Set dic = CreateObject("scripting.dictionary")
Set wks = ActiveSheet
mypath = "C:\Users\limor.tzach\Google Drive\Commission\2018\Monthly VBA\Statement" & "\"
Application.ScreenUpdating = False
With wks
For x = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If (Not dic.exists(.Cells(x, "A").Value)) Then
dic.Add .Cells(x, "A").Value, .Cells(x, "A").Value
.Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:=.Range("A" & x)
.Range("A1").CurrentRegion.Copy
With Sheets.Add
With .Range("A1")
.PasteSpecial Paste:=xlAll
End With
.Name = "Overview"
.AutoFilterMode = False
End With
End If
Next
End With
End Sub
Sub testt()
Dim dic As Object, rng As Range, wks As Worksheet, mypath As String, x As Long
Set dic = CreateObject("scripting.dictionary")
Set wks = ActiveSheet.Next.Select
With wks
For x = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If (Not dic.exists(.Cells(x, "A").Value)) Then
dic.Add .Cells(x, "A").Value, .Cells(x, "A").Value
.Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:=.Range("A" & x)
.Range("A1").CurrentRegion.Copy
With Sheets.Add
With .Range("A1")
.PasteSpecial Paste:=xlAll
End With
.Name = "Renewals List"
AutoFilterMode = False
End With
End If
Next
End With
End Sub
Sub testtt()
mypath = "C:\Users\limor.tzach\Google Drive\Commission\2018\Monthly VBA\Statement" & "\"
Application.ScreenUpdating = False
Worksheets(Array("Overview", "Renewals List")).Copy
With ActiveWorkbook
.SaveAs Filename:=(mypath & wks.Range("A" & x))
.Close SaveChanges:=False
End With
Loop
-
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Bookmarks