acerlaptop
New Member
- Joined
- Feb 17, 2020
- Messages
- 44
- Office Version
- 2013
- Platform
- Windows
Hi All,
I Have a table and Macro code below. What I want to do is:
-Copy all numbers to a worksheet named "TEST" (Helper worksheet)
-Criteria are:
1. If Header of Column is "Total" - End VBA
2. Start with Range(E2) then if value is "-" or if Value of Cells(activerow, 2) = blank then select next row
3. If activerow is greater than LastRow, select next column row 2.
4. if Value is not "-" or if Value of Cells(activerow, 2) is NOT blank, then copy activecell to worksheet(test) range(A & LastRowT + 1)
But the macro just keeps runnig without ending.
Any ideas?
Thanks
I Have a table and Macro code below. What I want to do is:
-Copy all numbers to a worksheet named "TEST" (Helper worksheet)
-Criteria are:
1. If Header of Column is "Total" - End VBA
2. Start with Range(E2) then if value is "-" or if Value of Cells(activerow, 2) = blank then select next row
3. If activerow is greater than LastRow, select next column row 2.
4. if Value is not "-" or if Value of Cells(activerow, 2) is NOT blank, then copy activecell to worksheet(test) range(A & LastRowT + 1)
But the macro just keeps runnig without ending.
Any ideas?
Thanks
VBA Code:
Sub Test()
Application.ScreenUpdating = False
Dim aC As Integer
Dim aR As Integer
Dim ActiveC As Range
Dim LastRow As Integer
Dim LastrowT As Integer
Sheets.Add
ActiveSheet.Name = "TEST"
Sheets("Booking").Activate
Range("E2").Select
LastRow = Worksheets("Booking").Cells(Rows.Count, 1).End(xlUp).Row
aR = ActiveCell.Row
aC = ActiveCell.Column
Set ActiveC = Cells(aR, aC)
Do While True
If Cells(1, aC) = "Total" Then
Exit Do
Else
If aR > LastRow Then
Range(aC + 1 & "2").Select
Else
If Selection.Value = "-" Or Cells(aR, 2) = "" Then
Selection.Offset(1, 0).Select
Else
LastrowT = Worksheets("TEST").Cells(Rows.Count, 1).End(xlUp).Row
ActiveC.copy
Worksheets("TEST").Range("A" & LastrowT + 1).PasteSpecial xlPasteValues
End If
End If
End If
Loop
Application.ScreenUpdating = True
End Sub