Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88854

Looping from the limit of contents in a sheet to match and copy in VBA Excel

$
0
0

I'm new here, and this is my problem; in vba, excel 2010 I want to search for a specific word or a list of words in every row with content in one sheet and if it matched then it copy the entire row of that sheet and paste it in a new one at the first row, and then continues looping back and foward from sheet to sheet after the list of words ends. At the end you get a new sheet with a bunch of rows collected from your search Query. I got some initial code, dont know if you guys will like to see it. Thanks.

Sub Macro1()
    Dim sheetName As String
    Dim recintos As String
    Dim recintosArray() As String
    Dim namevar As Variant
    Dim sheetLimit As Integer
    Dim n As Integer

    'Words to search and copy in the sheet 
    'Nombre del sheet a buscar en el documento abierto
    sheetName = InputBox("Nombre de la hoja o sheet en donde desea copiar los recintos :")

    'Save a string type data 
    'Guarda los datos como tipo cadena
    recintos = InputBox("Introduzca los nombres  de los recintos separados por coma :", "Buscador de recintos", "00000,00000,00000...")

    'Split the words and save it in array type 
    'Separa la cadena y los guarda en un arreglo
    recintosArray() = Split(recintos, ",")
    namevar = InputBox("Introduzca el nombre de la hoja que desea crear para pegar c/u :")

    'Makes a new sheet and defines a name
    'Crea un sheet nuevo y define el nombre
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = namevar
    sheetLimit = Sheets(sheetName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    'Array index
    'Indice del arreglo recintosArray
    n = 0

    For i = 1 To sheetLimit
        Sheets(sheetName).Activate
        currentCellName = Sheets(sheetName).Cells(i, 1).Value

        If n <= UBound(recintosArray) Then
            If Replace(currentCellName, Chr(32), "") = recintosArray(n) Then
                Sheets(sheetName).Rows(i).Copy
                newSheetLimit = Sheets(namevar).Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
                Sheets(namevar).Activate
                Sheets(namevar).Cells(newSheetLimit + 1, 1).Select
                ActiveSheet.Paste
                n = n + 1
                i = 1
            End If
        End If
    Next i
End Sub


Viewing all articles
Browse latest Browse all 88854

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>