Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Adjust macro
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! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
macro adjust | Excel Worksheet Functions | |||
to adjust download | Excel Discussion (Misc queries) | |||
How do I adjust a curve ? | Charts and Charting in Excel | |||
cells don't adjust | Excel Discussion (Misc queries) | |||
cells don't adjust | Excel Discussion (Misc queries) |