This is my code to search for matching data in column C, then cut and paste all adjacent rows to different tab. Delete blank cells and repeat. The code works, but stops working once there are 500+ rows to search through. No error messages, it just want loop through all of the data.
Sub BeginPullingPins()
Dim wstSource As Worksheet, _
wstDestination As Worksheet
Dim rngCell As Range, _
rngMyData As Range
Dim lngMyRow As Long
Set wstSource = Worksheets("RawData")
Set wstDestination = Worksheets("DataCleaning")
Set rngMyData = wstSource.Range("A1:J" & Range("J" & Rows.Count).End(xlUp).Row)
With Destination
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
N = 1
For i = 1 To lastrow
If i = lastrow Then
If Range("C" & i).Value <> Range("C" & i - 1).Value Then
Range("C" & N & ":CJ" & i).Select
N = i + 1
With Worksheets("RawData")
cpy.Cut Destination:=.Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0)
End With
End If
Else
If Range("C" & i).Value <> Range("C" & i + 1).Value Then
Range("C" & N & ":CJ" & i).EntireRow.Cut
N = i + 1
Sheets("DataCleaning").Select
Range("A1").Select
ActiveSheet.Paste
End If
End If
Next i
Sheets("RawData").Select
Dim lRow As Long
Dim iCntr As Long
lRow = 40
For iCntr = lRow To 1 Step -1
If Trim(Cells(iCntr, 1)) = “” Then
Rows(iCntr).Delete
Else
End If
Next
Sheets("DataCleaning").Select
End With
End Sub
Aucun commentaire:
Enregistrer un commentaire