VBA: Copying from Table and Pasting to Create List

Question

New to VBA

I am trying to copy rows containing a month from a table and paste them into cells. However, they paste upward instead of downward. Any help is appreciated.

Sub tblcopypast()

Dim Month As String
Dim tbl As ListObject
Dim i As Integer
Dim lastrow As Integer

Set tbl = ActiveSheet.ListObjects("Table1")
Month = ActiveSheet.Range("E1").Value
lastrow = tbl.ListRows.Count

For i = 1 To lastrow
    If tbl.DataBodyRange(i, 2) = Month Then
    tbl.ListRows(i).Range.Copy
    ActiveSheet.Range("rng").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
    End If
Next

End Sub

Answer 1

Your ActiveSheet.Range("rng").End(xlUp).Offset(1, 0).PasteSpecial is quite tricky. Especially in a loop. Try below code:

Option Explicit

Sub tblcopypast()

Dim Month As String
Dim tbl As ListObject
Dim iCt As Integer
Dim jCt As Integer
Dim lastrow As Integer
Dim targetRange As Range
Dim actRange As Range

    Set tbl = ActiveSheet.ListObjects("Table1")
    Month = ActiveSheet.Range("E1").Value
    lastrow = tbl.ListRows.Count
    jCt = 0
    Set actRange = ActiveCell

    Set targetRange = ActiveSheet.Range("rng").End(xlUp).Offset(1, 0)

    For iCt = 1 To lastrow
        If tbl.DataBodyRange(iCt, 2) = Month Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
    Next
    actRange.Select
End Sub

Sub DefineSamples()
'sample data I used to review your code!
Dim cell As Range
    Range("M1") = "F1"
    Range("N1") = "F2"
    Range("O1") = "F3"
    Range("P1") = "F4"

    For Each cell In Range("M2:P12")
        cell.Value = Int(Rnd() * 100)
    Next cell

    Range("E1").Value = "Jan"

    Range("N3").Value = "Jan"
    Range("N5").Value = "Jan"
    Range("N7").Value = "Jan"
    Range("N9").Value = "Jan"
    Range("N10").Value = "Jan"
    Range("N11").Value = "Jan"

    On Error Resume Next
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$M$1:$P$12"), , xlYes).Name = "Table1"
    On Error GoTo 0
    Range("Table1").HorizontalAlignment = xlCenter
End Sub