How to find data and export it to another excel sheet

Question

How to find data and export it to another excel sheet

Navigation

#1 by (2 votes)

1

I am currently working on a code which should:

Read the item that the user selects from a Combobox, for example:

Go to a page called "MEMORIES ACT" and search for this item, in the columns "CJ" and "CK" (it is done in these 2 columns since the headings are in a combined cell)

As you can see the item you are looking for is the header of some tables, once you find the item that the user wants to search, you must copy the data that belongs to that item and take them to a sheet called "SPLICES"

They are copied and, as I said, they are taken to the "EMPALMES" sheet and on that sheet the elements must be pasted from the cell B2 , in the following way :

I attached the code that I did to try to do all of the above, but the code does not work for me, I always get the error or the error 13 (the types do not match) or the 404 (An object is required)

    Private Sub cmdagacc_Click()

Set h1 = Sheets("MEMORIAS ACTO")    'Origen
Set h2 = Sheets("EMPALMES")         'Destino


Set R1 = h1.Range("CJ29")
Set R2 = h1.Range("CJ87")
Evn = cbxtacc.Value
Dim rng As Range

If cbxtacc.Value = "" Or cbxtacc.ListIndex = -1 Then
    MsgBox "Seleccione un tipo de Accesorio"
    cbxtacc.SetFocus
    Exit Sub
End If

Existe = False
Dim R As Object
Set b = h1.Range("CJ29:CK87").Find(Evn, LookIn:=xlValues, LookAt:=xlWhole)

If Not b Is Nothing Then
    cl = b.Address

    Do
        Fila = b.Row + 1
        k = 2
        For j = Cells("CJ29").Cells To Columns("CK87").Column
            If h1.Cells(Fila, j).Value = cbxtacc.Value Then
                Existe = True
                Fila = Fila + 1
                k = k + 1
            Do While h1.Cells(Fila, j).Value <> ""
                h2.Cells(k, "B").Value = h1.Cells(Fila, j).Value
                h2.Cells(k, "C").Value = h1.Cells(Fila, j + 1).Value
                Fila = Fila + 1
                k = k + 1
            Loop
        Exit For
            End If
        Next

    Loop While Not b Is Nothing And b.Address <> cl
End If

If Existe = False Then
    MsgBox "Error al agregar los Accesorios", vbExclamation
Else
    MsgBox "Accesorios agregados", vbInformation
End If

Range("A1") = "Empalmes"

End Sub

I appreciate all the help you can give me, and I hope to see you succeed in explaining me clearly

vba macros excel

asked by stefa zapata 27.07.2018 в 18:29

source

1 answer

Disable the readonly attribute Can a request be made in an ng-click event?

score 2 · Accepted Answer

I hope this code is useful for you:

Option Explicit
Private Sub cmdagacc_Click()

    Dim wb As Workbook, h1 As Worksheet, h2 As Worksheet
    Dim R1 As Range
    Dim Evn As String
    Dim FilaI As Long, FilaF As Long, LastRow As Long

    Set wb = ThisWorkbook 'es importante hacer referencia al libro además de la hoja, por si hay otros libros con hojas del mismo nombre
    Set h1 = wb.Sheets("MEMORIAS ACTO")
    Set h2 = wb.Sheets("EMPALMES")

    If cbxtacc.Value = "" Or cbxtacc.ListIndex = -1 Then
        MsgBox "Seleccione un tipo de Accesorio"
        cbxtacc.SetFocus
        Exit Sub
    Else
        Evn = cbxtacc.Value
    End If

    LastRow = h1.Range("CJ100000").End(xlUp).Row 'contamos hasta la última fila para que a medida que se añadan cosas, el rango aumente
    Set R1 = h1.Range("CJ29:CK" & LastRow) 'este rango será dinámico entendiendo que los accesorios comienzan en la fila 29 y terminan en la 100000

    FilaI = R1.Cells.Find(Even).Row 'buscamos la fila en la que se encuentra lo que queremos
    FilaF = h1.Cells(FilaI, "CJ").End(xlDown).Row 'buscamos la fila en la que termina teniendo en cuenta que siempre dejas una fila en blanco entre grupos de accesorios

    h1.Range(h1.Cells(FilaI + 1, "CK"), h1.Cells(FilaF, "CJ")).Copy 'copiamos los datos
    h2.Cells(2, 2).PasteSpecial xlPasteValues 'pegamos sólo los valores


End Sub

I recommend you declare the variables that you are going to use in your functions since otherwise there may be errors, a very good option to not forget any variable without declaring, is to put the module at the top: Option Explicit since forces you to declare them all.

What I have set for you is a code that first verifies that your combobox is not empty and then assigns the value to Evn.

Then look for the last row with data in the memo sheet act so that if you add accessories you do not have to change the macro. Done this creates the rank R1 taking from the CJ29 (I understand that there the list begins) and it ends by the CK and the last row that would have with data.

With all that done then I just look for the row where the value of the combobox is and the last row by the End method (it's as if you press the ctrl + arrow of direction on your keyboard, it puts you in the last that there is data in the direction you say).

Once I have understood the range of data I want to copy, then simply copy and paste values in cell B2 of the splices page.

If it does not work it's because it does not find the value and that can be typographical errors.