如果某些列在值之间，则将整个行复制到 Excel 中的新工作表

Question

I have a huge excel file with data, and i want to create a new sheet with only the rows that one of their columns (column "Date" in my example) is between the values 5 to 10.

For example,

I have data like this:

Date  m  X   Y

4    30  5   7

7    31  5   7

7    32  5   7

9    33  5   7

10   34  5   7

2    35  5   7

And I want to make new sheet like this:

Date  m  X   Y

7    31  5   7

7    32  5   7

9    33  5   7

Any leads ?

Answer 1

How's something like this:

Sub test()
Dim lastRow As Integer, newLastRow As Integer, lastCol As Integer
Dim ws As Worksheet, newWS As Worksheet

Set ws = ActiveSheet
Set newWS = Sheets.Add
newWS.Name = "Parsed Info"

Dim cel As Range, rng As Range

newLastRow = 1

With ws
    lastRow = .Cells(1, 1).End(xlDown).Row
    For Each cel In .Range(.Cells(1, 1), .Cells(lastRow, 1))
        If 10 >= cel.Value And cel.Value >= 5 Then
            lastCol = .Cells(cel.Row, 1).End(xlToRight).Column
            Set rng = .Range(.Cells(cel.Row, 1), .Cells(cel.Row, lastCol))
            rng.Copy
            With newWS
                .Range(.Cells(newLastRow, 1), .Cells(newLastRow, lastCol)).PasteSpecial
            End With
            newLastRow = newLastRow + 1
        End If
    Next cel
End With

Application.CutCopyMode = False
End Sub