Selected range of cells via VBA doesn't work

Question

EDITED

I would like to ask you for help & revision of my VBA code as I am new to VBA.

I have pivot table with 3 columns. Via slicer I choose the items I want to add in new data table, each item must be added 3 times - therefore in the code I used loop 3 times. The VBA works perfectly when 2 or more items are chosen.

However, when only single item is selected, the VBA crashes because the "selected copied range" does not have the same size as "pasted range" size. Basically, it selects all cells from column "F2:H2" until the end of spreadsheet.

Sub Copy()

Dim i

For i = 1 To 3

StartRange = "F2:H2"
EndRange = "F2:H2"
Set a = Range(StartRange, Range(StartRange).End(xlDown))
Set b = Range(EndRange, Range(EndRange).End(xlDown))

Union(a, b).Select
    Selection.Copy
    lastrow = ActiveSheet.Cells(Rows.Count, "T").End(xlUp).Row + 1
    Cells(lastrow, "T").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Next i

End Sub

How to modify the code, if only single item is selected, it will copy the cells in new data table as well?
I can provide a test file for reference.

You might benefit from reading How to avoid using Select in Excel VBA. • Note that "does not work" is no useful error description. Also it is not clear what your code should do. There is a loop but you never use i so it does the exact same thing 3 times. Please edit your question and try to give a good example what is wrong with your code. Screenshots might help to explain things. — Pᴇʜ

CDP1802 CDP1802 · Accepted Answer · 2020-05-20T11:28:45

Use .End(xlDown) from the header row.

Option Explicit

Sub Copy()

    Dim ws As Worksheet, rng As Range
    Dim i As Long, lastrow As Long

    Set ws = ThisWorkbook.ActiveSheet
    Set rng = ws.Range("F2", ws.Range("H1").End(xlDown))

    For i = 1 To 3
        lastrow = ws.Cells(Rows.Count, "T").End(xlUp).Row + 1
        rng.Copy
        ws.Cells(lastrow, "T").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i

End Sub

or to copy single rows

Sub Copy2()

    Const REPEAT = 3

    Dim ws As Worksheet, rng As Range
    Dim row As Range, lastrow As Long

    Set ws = ThisWorkbook.ActiveSheet
    Set rng = ws.Range("F2", ws.Range("H1").End(xlDown))

    lastrow = ws.Cells(Rows.Count, "T").End(xlUp).row + 1

    For Each row In rng.Rows
        If Not row.Hidden Then
            ws.Cells(lastrow, "T").Resize(REPEAT, row.Columns.Count).Value = row.Value
            lastrow = lastrow + REPEAT
        End If
    Next

End Sub

Selected range of cells via VBA doesn't work

1 Answers