Microsoft Office Forums - View Single Post - Copying rows through to another worksheet using criteria and VBA

Philb1 · 06-01-2016, 03:05 AM

Try this
Sheet1 is the Data sheet where the new data is transferred to.
Sheet2 is the sheet where you paste the raw data dump.
The macro will transfer any row that has an empty cell in column S and on the same row in column P the text ends with .99
It takes columns C to I and columns P to T from the Dump sheet & pastes it into columns C to N on the Data sheet.

I think it's what you're after
Cheers

I wonder why this site doesn't like xlsb

Code:

Option Explicit

Sub CopyDataOver()

Dim AllData() As Variant, ColsC2I() As Variant, ColsP2T() As Variant
Dim Lrow As Long, A As Long, i As Long, j As Long
Dim str99 As String
str99 = ".99"

'   Clear the data sheet from row 5 down ready for new data
    If Not IsEmpty(Sheet1.Range("C5")) Then
        Sheet1.Range("C5:T" & Sheet1.Cells.Find(What:="*", LookIn:=xlValues, _
                    LookAt:=xlPart, Searchorder:=xlByRows, _
                    searchdirection:=xlPrevious, MatchCase:=False, searchformat:=False).Row).Clear
    End If

'   Find last used row of  data on The Dump sheet
    Lrow = Sheet2.Cells.Find(What:="*", LookIn:=xlValues, _
                LookAt:=xlPart, Searchorder:=xlByRows, _
                searchdirection:=xlPrevious, MatchCase:=False, searchformat:=False).Row
        
    If Lrow < 5 Then Lrow = 5 ' Prevent header being deleted etc

'   Count how many cells in Column P end with .99
    A = Application.WorksheetFunction.CountIf(Sheet2.Range("P5:P" & Lrow), "*" & str99)

ReDim AllData(1 To Lrow - 4, 1 To 18)
ReDim ColsC2I(1 To A, 1 To 7)
ReDim ColsP2T(1 To A, 1 To 5)

    AllData = Sheet2.Range("C5:T" & Lrow).Value2
    j = 1

    For i = LBound(AllData) To UBound(AllData)
    
'   If cell P5+ ends with .99 and cell S5+ is empty
        If Right(AllData(i, 14), Len(AllData(i, 14)) + 3 - Len(AllData(i, 14))) = str99 And IsEmpty(AllData(i, 17)) Then
        
            ColsC2I(j, 1) = AllData(i, 1): ColsC2I(j, 2) = AllData(i, 2): ColsC2I(j, 3) = AllData(i, 3)
            ColsC2I(j, 4) = AllData(i, 4): ColsC2I(j, 5) = AllData(i, 5): ColsC2I(j, 6) = AllData(i, 6)
            ColsC2I(j, 7) = AllData(i, 7)
            
            ColsP2T(j, 1) = AllData(i, 14): ColsP2T(j, 2) = AllData(i, 15): ColsP2T(j, 3) = AllData(i, 16)
            ColsP2T(j, 4) = AllData(i, 17): ColsP2T(j, 5) = AllData(i, 18)
            
            j = j + 1
            
        End If
    Next i

'   Paste 1st part of data on to Data sheet
    Sheet1.Range("C5").Resize(UBound(ColsC2I, 1), UBound(ColsC2I, 2)).Value2 = ColsC2I
'   Paste 2nd part of data on to Data sheet
    Sheet1.Range("J5").Resize(UBound(ColsP2T, 1), UBound(ColsP2T, 2)).Value2 = ColsP2T


Erase AllData
Erase ColsC2I
Erase ColsP2T

Exit Sub

End Sub