hard macro

[lealeadupont]

can someone help me please ?

Write 2 Macros (not record): - The first one - name it “DeleteRows”. The Macro has to delete every second line/row. The original Table has 30 rows – after running the macro only 15 will remain. -
The second one – name it "MyCopy". The macro will copy from sheet Question4a, range A1:A30 into Question4b range A1:A30.

and the table is a list with phrases

 

[MARK858]

Try...

Sub DeleteRows()

    Dim LastRow As Long, wRng As Range, iRow As Long
    LastRow = Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row

    For iRow = LastRow To 1 Step -2
        If wRng Is Nothing Then
            Set wRng = Rows(iRow)
        Else
            Set wRng = Union(wRng, Rows(iRow))
        End If
    Next iRow

    If Not wRng Is Nothing Then
        wRng.Delete
    End If

End Sub


Sub MyCopy()
Sheets("Question4a").Range("A1:A30").Copy Sheets("Question4b").Range("A1")
End Sub

 

[lealeadupont]

Try...

Sub DeleteRows()

    Dim LastRow As Long, wRng As Range, iRow As Long
    LastRow = Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row

    For iRow = LastRow To 1 Step -2
        If wRng Is Nothing Then
            Set wRng = Rows(iRow)
        Else
            Set wRng = Union(wRng, Rows(iRow))
        End If
    Next iRow

    If Not wRng Is Nothing Then
        wRng.Delete
    End If

End Sub


Sub MyCopy()
Sheets("Question4a").Range("A1:A30").Copy Sheets("Question4b").Range("A1")
End Sub

You're just amazing thank you sooo muchhh

 

[MARK858]

You're welcome. Thinking about it you are probably better off with the code below for the deletion

Sub DeleteRows()

    Dim LastRow As Long, wRng As Range, iRow As Long
    LastRow = Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row

    For iRow = 2 To LastRow Step 2
        If wRng Is Nothing Then
            Set wRng = Rows(iRow)
        Else
            Set wRng = Union(wRng, Rows(iRow))
        End If
    Next iRow

    If Not wRng Is Nothing Then
        wRng.Delete
    End If

End Sub