Copy last 3 rows excluding the rows for which there is a 0 in column C

0 votes

I want to duplicate the final three rows from A to AD, excluding those that have a "0" in column "C," from the last row in another file and sheet. I want there to always be three copied rows. The code below causes me trouble because it always duplicates only one row at the end.

Sub AB ()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim numCopied As Long
    Dim baseWB As Workbook, baseWS As Worksheet
    Dim spWB As Workbook, spWS As Worksheet

    Set baseWB = ThisWorkbook
    Set baseWS = ActiveSheet

    lastRow = spWS.Cells(spWS.Rows.Count, "D").End(xlUp).Row

    numCopied = 0
    For i = lastRow To lastRow - 8 Step -1
        ' Sprawdź, czy w kolumnie C jest 0
        If spWS.Cells(i, "C").Value <> 0 Then
            spWS.Range(spWS.Cells(i, "A"), spWS.Cells(i, "AD")).Copy
            numCopied = numCopied + 1
        End If
        If numCopied = 3 Then
            Exit For
        End If
    Next i


    baseWB.Sheets("Sheet1").Range("E5").PasteSpecial xlPasteValues
    spWB.Close SaveChanges:=False
   
 
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
Jan 10 in Others by Kithuzzz
• 28,900 points
51 views

1 answer to this question.

0 votes

The copy inside the loop is overwriting the previous copy. They are not additive unless you use Union.

Option Explicit
Sub AB()

    Dim spWB As Workbook, spWS As Worksheet
    Dim baseWB As Workbook, baseWS As Worksheet
    Dim rng As Range, rngCopy As Range
    Dim lastRow As Long, i As Long, numCopied As Long
    
    Set baseWB = ThisWorkbook
    Set baseWS = baseWB.Sheets("Sheet1")
    
    ' open workbook to copy from
    Set spWB = Workbooks.Open("Source.xlsx", ReadOnly:=True)
    Set spWS = spWB.Sheets("Sheet1")
    numCopied = 0
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With spWS
    
        lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        For i = lastRow To 1 Step -1
            ' Sprawdz, czy w kolumnie C jest 0
            If .Cells(i, "C").Value <> 0 Then
                Set rng = .Cells(i, "A").Resize(, 30) ' A:AD
                If rngCopy Is Nothing Then
                    Set rngCopy = rng
                Else
                    Set rngCopy = Union(rng, rngCopy)
                End If
                numCopied = numCopied + 1
            End If
            If numCopied = 3 Then
                Exit For
            End If
        Next i
    End With
    
    ' copy
    If rngCopy Is Nothing Then
        MsgBox "No rows found to copy", vbExclamation
    Else
        rngCopy.Copy
        baseWS.Range("E5").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        MsgBox " Copied : " & rngCopy.Address, vbInformation
       
    End If
    spWB.Close SaveChanges:=False
     
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
answered Jan 10 by narikkadan
• 53,520 points

Related Questions In Others

0 votes
1 answer

Is there a color code for transparent in HTML?

There is no Transparent color code, but ...READ MORE

answered Feb 11, 2022 in Others by Soham
• 9,700 points
349 views
0 votes
0 answers

What is the best way to use a HashMap in C++?

Can someone recommend me some good documentation ...READ MORE

May 19, 2022 in Others by Kichu
• 19,050 points
95 views
0 votes
1 answer

How to find the last row in a column using openpyxl normal workbook?

ws.max_row will give you the number of rows ...READ MORE

answered Dec 25, 2022 in Others by narikkadan
• 53,520 points
406 views
0 votes
1 answer

Is there a way to quickly check what attribute the data is in a cell in a spreadsheet?

Excel will automatically make assumptions about the ...READ MORE

answered Jan 8 in Others by narikkadan
• 53,520 points
56 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
533 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
2,415 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 22,960 points
117 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,630 points
300 views
0 votes
1 answer

Is there any way in python to auto-correct spelling mistake in multiple rows of an excel files of a single column?

Use Spellchecker for doing your stuff: import pandas ...READ MORE

answered Oct 14, 2022 in Others by narikkadan
• 53,520 points
327 views
0 votes
1 answer

Why is just an ID in the URL path a bad idea for SEO?

yes it affects the click through rates ...READ MORE

answered Feb 20, 2022 in Others by narikkadan
• 53,520 points
119 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP