Forum Discussion

ShazSh's avatar
ShazSh
Brass Contributor
Jul 01, 2022
Solved

Copy highlighted rows and paste into new sheet

I am trying to find a code which could help me to copy those rows which are highlighted in Sheet1 and Paste them into new sheet always along with header.

 

I was using recorded macro before but that was extremly slow whenever i tried to run it.

 

I would appreciated the help if someone cn help in this regard so the code could process it within seconds even with the large data set.

Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Jul 01, 2022

    ShazSh 

    I'm afraid that having more than 10,000 check boxes has an enormous negative impact on performance. Even opening the workbook was very slow.

    I replaced the check boxes with "x"es in column A. The copy code can then use AdvancedFilter.

    Is created a criteria range in K1:K2, and copied the headers in B1:AI1 manually to Sheet2. The code can then be:

    Private Sub CommandButton3_Click()
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:AI" & LastRow).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Range("AK1:AK2"), _
        CopyToRange:=Worksheets("Sheet2").Range("B1:AI1")
End Sub

     The code runs in a handful of seconds on my PC.

    See the attached version.

1 Reply

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 01, 2022

    ShazSh 

    I'm afraid that having more than 10,000 check boxes has an enormous negative impact on performance. Even opening the workbook was very slow.

    I replaced the check boxes with "x"es in column A. The copy code can then use AdvancedFilter.

    Is created a criteria range in K1:K2, and copied the headers in B1:AI1 manually to Sheet2. The code can then be:

    Private Sub CommandButton3_Click()
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:AI" & LastRow).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Range("AK1:AK2"), _
        CopyToRange:=Worksheets("Sheet2").Range("B1:AI1")
End Sub

     The code runs in a handful of seconds on my PC.

    See the attached version.

Resources