Sorting and cutting part of the sort into a new tab

[JB1409]

Dear all,

I am optimizing a macro I'm using for data analysis and I have a question.

My macro now can sort my data based on the "channel" in column C, these are two channels with either value "1" or value "2". At this moment I'm sorting it with my macro, but I'm looking for code that will allow me to automatically select al the rows with value "2" (the bottom part of the sheet) so I can cut them into the sheet named "380 nm".

I can't seem to find a way to do this, the amount of rows and columns I have is different per dataset, but if I can span C2:C1403 with my code it will be enough.

Thanks for the help!

Best,
JB

[Grade4.2]

Dear all,

I am optimizing a macro I'm using for data analysis and I have a question.

My macro now can sort my data based on the "channel" in column C, these are two channels with either value "1" or value "2". At this moment I'm sorting it with my macro, but I'm looking for code that will allow me to automatically select al the rows with value "2" (the bottom part of the sheet) so I can cut them into the sheet named "380 nm".

I can't seem to find a way to do this, the amount of rows and columns I have is different per dataset, but if I can span C2:C1403 with my code it will be enough.

Thanks for the help!

Best,
JB

You can use the Range.AutoFilter method to filter the data based on the value in column C. Then you can use the Range.SpecialCells method to get all the visible cells in column C.


Here is an example of how you can use these methods:


Dim rng As Range
' Set the range that you want to filter
Set rng = Range("C2:C1403")
' Filter the data based on column C
rng.AutoFilter field:=1, Criteria1:="2"
' Get all the visible cells in column C
Set rng = rng.SpecialCells(xlCellTypeVisible)
' Cut the selected cells and paste them in the "380 nm" sheet
rng.Cut Destination:=Sheets("380 nm").Range("A1")

After running this code, the rows with value "2" in column C will be cut and pasted in the "380 nm" sheet. You can modify the code as needed to fit your specific data and requirements.

[Grade4.2]

Sub CutRows()


Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim cell As Range


Set ws = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets.Add
ws2.Name = "380 nm"


Set rng = ws.Range("C2:C1403")
Set rng2 = Nothing


If Not rng Is Nothing Then
For Each cell In rng
If cell.Value = 2 Then
If rng2 Is Nothing Then
Set rng2 = cell
Else
Set rng2 = Union(rng2, cell)
End If
End If
Next cell
End If


rng2.Cut ws2.Range("A1")


End Sub


Or this one. Please let me know how you go.