Combobox para buscar y copiar resultados
Tengo un pregunta haber si me pueden ayudar nuevamente,
tengo un form con un combobox y optionbutton
Lo que quero hacer es escribir el nombre en el combo
Y con eso buscar en la hoja de "clientes" y copiar todos los resultados ala hoja "Encuesta"
Empezando a pegar en "A2" y hacia abajo
ejemplo en la hoja "clientes" en columna "A"=nombre "B"=direccion "C"=tel. "D"=cantidad. "E"=temporada
Igual es la hoja "Encuesta" quiero copiar todas las concidencias a esta hoja y imprimirla
El optionbutton lo quiero para si lo activo me haga el procedimiento anterior para todos los clientes que se encuentran en la hoja "Clientes" cada cliente tiene varios registros
1 respuesta
Este es un ejemplo parecido a lo que buscas, al seleccionar un nombre de la lista lo busca en la hoja cliente y copia todos sus registros a la hoja encuesta, al dar click en copiar todos copia todos los registros de la hoja clientes a la hoja encuesta.
Este es el codigo
Private Sub ComboBox1_Change()
Set HC = Worksheets("CLIENTES")
Set HE = Worksheets("ENCUESTAS")
Set CLIENTES = Range("CLIENTES")
Set DESTINO = HE.Range("A2").CurrentRegion
With DESTINO
FILAS = .Rows.Count: COLUMNAS = .Columns.Count
HE.Range("A1").Resize(1, CLIENTES.Columns.Count).Value = CLIENTES.Rows(0).Value
End With
With CLIENTES
CLIENTE = ComboBox1.Value
CUENTA = WorksheetFunction.CountIf(.Columns(1), CLIENTE)
If CUENTA > 0 Then
FILA = WorksheetFunction.Match(CLIENTE, .Columns(1), 0)
Set REGISTROS = .Rows(FILA).Resize(CUENTA)
If FILAS = 1 And COLUMNAS = 1 Then
DESTINO.Resize(CUENTA, .Columns.Count).Value = REGISTROS.Value
Else
DESTINO.Rows(DESTINO.Rows.Count + 1).Resize(CUENTA, .Columns.Count).Value = REGISTROS.Value
End If
End If
End With
End Sub
Private Sub OptionButton1_Click()
Set HE = Worksheets("ENCUESTAS")
Set CLIENTES = Range("CLIENTES")
With CLIENTES
HE.Range("A2").Resize(.Rows.Count, .Columns.Count).Value = .Value
HE.Range("A1").Resize(1, .Columns.Count).Value = .Rows(0).Value
End With
End Sub
Private Sub UserForm_Activate()
With UserForm1
.Caption = "MODULO DE CLIENTES"
.Move 150, 15
End With
End Sub
Private Sub UserForm_Initialize()
Dim unicos As New Collection
Set HC = Worksheets("clientes")
Set DATOS = HC.Range("a1").CurrentRegion
With DATOS
.Sort key1:=HC.Range(.Columns(1).Address), order1:=xlAscending, Header:=xlYes
FILAS = .Rows.Count: COLUMNAS = .Columns.Count
For i = 2 To FILAS
CLIENTE = .Cells(i, 1)
On Error Resume Next
unicos.Add CLIENTE, CStr(CLIENTE)
If Err.Number = 0 Then ComboBox1.AddItem CLIENTE
On Error GoTo 0
Next i
Set DATOS = .Rows(2).Resize(FILAS - 1, COLUMNAS)
.Name = "CLIENTES"
End With
End Sub
