selecting a specific range in excel

[Angel62]

I am realy new in Vba. I have a long data series in excel. but I want to select and cut some specific data range which are in column A and start with "MIN" till 33 rows after that. In each column there are 60 data series with different lengthen but all start with the row filled "MIN" till 33 rows after that. Between the range I want to select there are some other rows with data which aren't my goal. would you please help me to fix it? its my data sample. A B C 1 DAY MI MX 2 1 7 9 . . 32 31 4 11 . . 313 DAY MI MX 314 1 3 8 . . 641 DAY MI MX 615 1 2 15

<tbody>
</tbody>

 

[wigi]

Is it MIN or MI?

 

[Angel62]

Is it MIN or MI?

Its MIN. I wrote in briefly in my table. I just worked on vba 2 days! I must extract my data. I could copy all my ranges by hand but it takes time. I have 200 files that each files has 20000 rows and its really terrible to do by hand. All I could find is this code which i should at first find the row which has cells filled "MIN". Then I fill the range in this code by hand. but it takes time too. I want to write a code which :
1. find all cells filled "MIN"
2. Select the row which has "MIN"
3.extend selection till 33 rows
4.copy all ranges it finds

thank you in advance.

Sub CommandButton1_Click()

Range("A1:C9, A12:C20,........").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "New_List"
ActiveSheet.Paste

End Sub

 

[Israel Monreal]

Es lo que buscas?

Sub min ()
ColumnSearch = 1 'ponga el número de columna donde se encuentran "MIN"
ColumnEnd = Cells.SpecialCells (xlCellTypeLastCell). Columna 'última columna con el expediente
Las células (1, ColumnSearch). Seleccione
Para x = 1 Para Cells.SpecialCells (xlCellTypeLastCell). Fila
Si ActiveCell.Offset (x, ColumnSearch). Valor = "MIN" Entonces
RowStart = ActiveCell.Offset (x, ColumnSearch). Fila
Rango (Cells (RowStart, ColumnEnd + 5), células (RowStart + 33, ColumnEnd + 5)). Valor = "Recuperar"
End If
Siguiente x
Columnas (ColumnEnd + 5). Seleccione
campo Selection.AutoFilter: = 1, Criterios1: = "Recuperar"
Range (.. Cells (1, 1), células (Cells.SpecialCells (xlCellTypeLastCell) Row, Cells.SpecialCells (xlCellTypeLastCell) Columna - 5)).. SpecialCells (xlCellTypeVisible) Seleccione
Selection.AutoFilter
. Columnas (. Cells.SpecialCells (xlCellTypeLastCell) Columna) Eliminar cambio: = xlToLeft
End Sub

 

[Angel62]

At first thank you so much for your help. i tried it, it has syntax error. the only work i can do is just trying codes i find in net. this works but just extract the rows which has cell "min" and copy them in another sheet. but i want to extend the selection from the row it finds (has cell "min") till 33 rows after that.

Public Sub FindAndCopyit()
Dim Rng As Range
Dim rCell As Range
Dim copyRng As Range
Dim LCell As Range
Dim WB As Workbook
Dim srcSH As Worksheet
Dim destSH As Worksheet
Dim sFirst As String
Dim CalcMode As Long
Const strSearch As String = "MIN"

Set WB = ActiveWorkbook
Set srcSH = WB.Sheets("Find")
Set destSH = WB.Sheets("final")
Set Rng = srcSH.Range("A1:G20000")

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set rCell = Rng.Find(strSearch)
If Not rCell Is Nothing Then
Set copyRng = rCell.EntireRow
sFirst = rCell.Address
Do
Set rCell = Rng.FindNext(rCell)
If Not rCell Is Nothing And _
rCell.Address <> sFirst Then
Set copyRng = Union(rCell.EntireRow, copyRng)
End If
Loop Until rCell Is Nothing Or sFirst = rCell.Address
End If

Set LCell = destSH.Cells(Rows.Count, "A").End(xlUp)(2)

If Not copyRng Is Nothing Then
With copyRng
.Copy Destination:=LCell
.Delete
End With
End If

With Application
.CutCopyMode = False
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub