paulcherianc
07-25-2017, 03:38 AM
Dear Experts!!!!
I have drafted a macro to automate my excel.
1. Autofilter and create new worksheets based on the filter value with keeping the same format of the original file.
2. AutoFill Destination Range("A5: A6") to the end of the column.
3. Loop the process until the filter fields get over.
4. Filter Range will vary. (Range("C4:AT12").Select)). So macro should find the end of the range automatically.
Unfortunately, the macro is not copying the range I need to Paste on the newly created sheets.
My filter Row Range is fromA6 till AT6. The range I need to copy to new sheets starts from C4 till AT and end of the range.
Can any one help me to fix this?:banghead: I have attached a sample file with macro.
Thanks in advance!
Sub AutoFilterAndCreateNewSheets()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
'specify sheet name in which the data is stored
sht = "Timesheet"
'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets(sht).Range("A6:AT" & last)
Sheets(sht).Range("A6:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("XFD1"), Unique:=True
For Each x In Range([XFD2], Cells(Rows.Count, "XFD").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x
' Turn off filter
Sheets(sht).AutoFilterMode = False
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
I have drafted a macro to automate my excel.
1. Autofilter and create new worksheets based on the filter value with keeping the same format of the original file.
2. AutoFill Destination Range("A5: A6") to the end of the column.
3. Loop the process until the filter fields get over.
4. Filter Range will vary. (Range("C4:AT12").Select)). So macro should find the end of the range automatically.
Unfortunately, the macro is not copying the range I need to Paste on the newly created sheets.
My filter Row Range is fromA6 till AT6. The range I need to copy to new sheets starts from C4 till AT and end of the range.
Can any one help me to fix this?:banghead: I have attached a sample file with macro.
Thanks in advance!
Sub AutoFilterAndCreateNewSheets()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
'specify sheet name in which the data is stored
sht = "Timesheet"
'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets(sht).Range("A6:AT" & last)
Sheets(sht).Range("A6:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("XFD1"), Unique:=True
For Each x In Range([XFD2], Cells(Rows.Count, "XFD").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x
' Turn off filter
Sheets(sht).AutoFilterMode = False
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub