Forum Discussion

Copper Contributor

Feb 27, 2023

Solved

Need help with a VBA Macro for copying and pasting of rows.

Hello, My experience is fairly limited with Macro's, and even more so with VBA code (so please feel free to be as specific as possible). But I am building an automation flow that uses macro's in...

excel

Formulas and Functions

Macros and VBA

HansVogelaar

Feb 27, 2023

JB_SE_ED

Thank you, I downloaded the workbook. Try this version:

Sub Sample()
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("F1:F" & LastRow).AutoFilter Field:=1, Criteria1:="2"
    Range("A2:F" & LastRow).Copy Destination:=Range("A" & LastRow + 1)
    Range("F1:F" & LastRow).AutoFilter Field:=1
End Sub

HansVogelaar

MVP

Feb 27, 2023

JB_SE_ED

Which version of Office do you have?

Microsoft 365

Office 2021

Office 2019

...

JB_SE_ED

Copper Contributor

Feb 27, 2023

HansVogelaar Microsoft 365

JB_SE_ED
Copper Contributor
Feb 28, 2023
This is perfect. Thank you so much! HansVogelaar

HansVogelaar

MVP

Feb 27, 2023

JB_SE_ED

Try this:

Sub Sample()
    Dim LastRow As Long
    Dim Uniques
    Dim OneValue
    Dim NewLastRow As Long
    Dim Idx As Long
    Application.ScreenUpdating = False
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    NewLastRow = LastRow
    Uniques = Application.Unique(Range("F2:F" & LastRow))
    For Each OneValue In Uniques
        If OneValue > 1 Then
            Range("F1:F" & LastRow).AutoFilter Field:=1, Criteria1:=OneValue
            For Idx = 1 To OneValue - 1
                Range("A2:F" & LastRow).Copy Destination:=Range("A" & NewLastRow + 1)
                NewLastRow = Range("A" & Rows.Count).End(xlUp).Row
            Next Idx
        End If
    Next OneValue
    Range("F1:F" & LastRow).AutoFilter Field:=1
    Application.ScreenUpdating = True
End Sub

HansVogelaar
MVP
Feb 27, 2023
JB_SE_ED

There is probably a better way to do this with VSTACK etc.

(Wait - I made a mistake. I'll be back)