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

[JB_SE_ED]

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 various parts of the process. I have managed to troubleshoot and fix the macros in other parts of the flow, all except for this one.

This macro's purpose is to;

1. Filter the data set based on the number in column "F"
2. Select columns "A:F" and copy all rows of the resulting data set
3. Remove all filters
4. paste the rows that were just copied, at the first empty row at the bottom of the data set.

Steps 1-3 are working perfectly, but when the code gets to step 4, the paste function is not working.

I have researched and altered the code in several different ways with no success. One thing I find odd, is that the code I am using now will work if I paste into the last row that contains data, but not when I try to paste into the first empty row (the row right below). 

 This is the code i'm using

This is the worksheet with the filter applied

Please tell me what i'm doing wrong.

Thanks!

[#2]

@JB_SE_ED 

Could you attach a small sample workbook demonstrating the problem (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar?

[#3]

@Hans Vogelaar I've attached a sample file below. There should only be one Macro in the workbook named "Sample". That's what i'm trying to run. Sample Workbook

[#4]

@JB_SE_ED 

I don't have access to your SharePoint. Can you share the file?

[#5]

@Hans Vogelaar I couldn't find a way to link the file to the reply, but it allowed me to message it to you. Let me know if you have any trouble accessing it that way.

[#6 · Accepted solution]

@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

[#7]

@Hans Vogelaar That's fantastic! It works flawlessly now. Thank you! Now if I wanted it to repeat the function, scaling the 'Criteria1' up by one each time (ie: Criteria1:="2", then Criteria1:="3", etc...), would I just have to repeat the line of code, changing the 'Criteria1' as I go? Or is there something else I would need to alter?

[#8]

@Hans Vogelaar So my end goal is essentially this; Whatever number is represented in column 7, I need that row to appear in the data set that many times (ie: if column 7 on row 2 is "4", then I need to copy/paste row 2 into the data set 3 more times). The number in column 7 can vary anywhere from 1-25.

This is a data set generated from another program, listing specific components(Columns B&C) that are tied back to a certain dwg#(Column D). But Each dwg# may have more than one unit assigned to it (Column E). The total number of units per dwg# is represented in Column F.

What i'm attempting, is to generate a list of total number of components needed, taking into account the total number of units per dwg#.

You may know a better way I can go about this?

[#9]

@JB_SE_ED 

Which version of Office do you have?

Microsoft 365

Office 2021

Office 2019

...

[#10]

@Hans Vogelaar Microsoft 365

[#11]

@JB_SE_ED 

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

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

[#12]

@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

[#13]

This is perfect. Thank you so much! @Hans Vogelaar