Adjust macro

P

puiuluipui

Hi, i need the below macro to work even if in sheet1 i insert a row at the
top. Now, the datas begin from row 1. I need this macro to work if the data
start from row 2, and row 1 is empty.

Macro:
Sub ExtractReps()

Application.ScreenUpdating = False

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim NextRow

Set ws1 = Sheets("Sheet1")
Set rng = Range("Database1")

'extract a list of Sales Reps
ws1.Columns("F:F").Copy _
Destination:=Range("P1")
ws1.Columns("P:p").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("N1"), Unique:=True
r = Cells(Rows.Count, "N").End(xlUp).Row

'set up Criteria Area
Range("P1").Value = Range("F1").Value

For Each c In Range("N2:N" & r)
'add the rep name to the criteria area
ws1.Range("P2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then

Set ws2 = Sheets(c.Value)
Else

Set ws2 = Sheets.Add
End If

With ws2

.Move After:=Worksheets(Worksheets.Count)
.Name = c.Value

If .Range("A1").Value = "" Then

NextRow = 1
ElseIf .Range("A2").Value = "" Then

NextRow = 2
Else

NextRow = .Range("A1").End(xlDown).Row + 1
End If
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("P1:p2"), _
CopyToRange:=.Cells(NextRow, "A"), _
Unique:=False
End With

'start autofit all sheets
Cells.Select
Selection.ColumnWidth = 8.57
Cells.EntireColumn.autofit
Range("A1").Select
'end autofit all sheets


Next



ws1.Select
ws1.Columns("N:p").Delete

Application.ScreenUpdating = True

End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Can this be done?
Thanks!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top