CesarC
08-24-2017, 03:43 AM
Hi! I am pretty new with macros and new in this forum,
I am trying to make several macros work in the same spreadsheet, but:
Call Worksheet_Change(ByVal Target As Excel.Range)
doesn't work.
Here is the whole code:
Sub InsertNewRowAndReorder()
If Not Target.Column = "7" Then Exit Sub
Application.EnableEvents = False
Call Worksheet_Change(ByVal Target As Excel.Range)
Call sbInsertingRows
Call Makro1
End Sub
Sub Worksheet_Change(ByVal Target As Excel.Range)
Me.UsedRange.Sort Key1:=Columns("D"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Application.EnableEvents = True
Me.UsedRange.Sort Key1:=Columns("C"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Application.EnableEvents = True
Me.UsedRange.Sort Key1:=Columns("A"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Application.EnableEvents = True
End Sub
Sub sbInsertingRows()
Range("A2").EntireRow.Insert
End Sub
Sub Makro1()
Dim i As Integer
With ActiveSheet
totalRows = .Cells(.Rows.Count, "A").End(xlUp).Row
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To totalRows
If .Cells(i, 100).Value > 0 Then
Number = .Cells(i, 19).Value
Do While Number > 0
lastRow = lasRow + 1
.Rows(i).Copy
.Rows(lastRow).PasteSpecial xlPasteValues
Number = Number - 1
Loop
End If
Next i
End With
End Sub
Any Ideas very or tips welcome, thanks!!
I am trying to make several macros work in the same spreadsheet, but:
Call Worksheet_Change(ByVal Target As Excel.Range)
doesn't work.
Here is the whole code:
Sub InsertNewRowAndReorder()
If Not Target.Column = "7" Then Exit Sub
Application.EnableEvents = False
Call Worksheet_Change(ByVal Target As Excel.Range)
Call sbInsertingRows
Call Makro1
End Sub
Sub Worksheet_Change(ByVal Target As Excel.Range)
Me.UsedRange.Sort Key1:=Columns("D"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Application.EnableEvents = True
Me.UsedRange.Sort Key1:=Columns("C"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Application.EnableEvents = True
Me.UsedRange.Sort Key1:=Columns("A"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Application.EnableEvents = True
End Sub
Sub sbInsertingRows()
Range("A2").EntireRow.Insert
End Sub
Sub Makro1()
Dim i As Integer
With ActiveSheet
totalRows = .Cells(.Rows.Count, "A").End(xlUp).Row
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To totalRows
If .Cells(i, 100).Value > 0 Then
Number = .Cells(i, 19).Value
Do While Number > 0
lastRow = lasRow + 1
.Rows(i).Copy
.Rows(lastRow).PasteSpecial xlPasteValues
Number = Number - 1
Loop
End If
Next i
End With
End Sub
Any Ideas very or tips welcome, thanks!!