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
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
