I want to transfer collumn with "No" criteria in CTA demisie sheet and delete it from the CTA one.
CodePudding user response:
I understand that you want to move all rows from the sheet named CTA that have the value "No" in column "F" to the sheet named CTA-Demise. That is what the following code does. You just need to open the VBA code editor, insert a new module and paste this code there. Then run the code.
Sub move_cta_no()
Dim src As Worksheet
Dim dest As Worksheet
Dim r As Long
Dim free_row As Long
Set src = ThisWorkbook.Worksheets("CTA")
Set dest = ThisWorkbook.Worksheets("CTA-Demise")
free_row = dest.Cells(dest.Rows.Count, 1).End(xlUp).row
For r = src.Cells(src.Rows.Count, "F").End(xlUp).row To 2 Step -1
If src.Cells(r, "F").Value = "NO" Then
'found a row that needs to be moved
free_row = free_row 1
src.Rows(r).Copy
dest.Rows(free_row).Value = src.Rows(r).Value
src.Rows(r).Delete
End If
Next
End Sub
CodePudding user response:
Move Data Using AutoFilter
Option Explicit
Sub MoveCTA()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet: Set sws = wb.Worksheets("CTA")
If sws.FilterMode Then sws.ShowAllData
Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)
Dim dws As Worksheet: Set dws = wb.Worksheets("CTA demisie")
Dim dCell As Range
Set dCell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
srg.AutoFilter srg.Columns.Count, "No"
Dim svdrg As Range
On Error Resume Next
Set svdrg = sdrg.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
sws.AutoFilterMode = False
If Not svdrg Is Nothing Then
svdrg.Copy dCell
svdrg.Delete xlShiftUp
End If
Application.ScreenUpdating = True
MsgBox "Data moved.", vbInformation
End Sub