.
No hace falta muchos conocimientos para poder adaptar este ejemplo a tu proyecto de macro en Excel, solo cambiar las referencias, es decir nombre de hojas y celdas que contienen los datos o donde se guardarán los datos, si te resulta complicado puedes contactarme y te proporcionaré un guía para que puedas adaptarlo.
El vídeo explica más en detalle su funcionamiento, te recomiendo verlo, además de ver en forma gráfica el ejemplo y que hace cada parte del código, lo cual es un poco complicado de explicar con letras.
A grandes rasgos el ejemplo permite copiar una fila con datos seleccionada en un listbox a una hoja de Excel, para ello se debe seleccionar el datos que necesitemos, que podemos buscar con el buscador instalado en el mismo formulario, una vez encontrado el dato se selecciona y presiona el botón del formulario que permite copiar los datos seleccionados en el listbox a la hoja de Excel.
La codificación primero validad que se haya seleccionado un dato caso contrarío sale un mensaje y no hace nada; en caso que se haya seleccionado, determina en la hoja donde se van a copiar los datos seleccionados del listbox y cual es la última fila con datos copiando los mismos en la fila siguiente que está vacía.
Sugiero descargar el ejemplo y ver su funcionamiento conjuntamente con el vídeo explicativo, desde el link del final se puede descargar su uso es libre; si te fueron de utilidad considera la posibilidad de invitarme una tasa de café para seguir subiendo cosas útiles.
Suscribe a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlas, buscar en listbox mientras escribes en textbox, ordenar hojas libro excel por su nombre, conectar Excel con Access y muchos ejemplos más.
if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}
Código que se inserta en un módulo
UserForm1.Show
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
conta = 0
For x = 0 To Me.ListBox1.ListCount – 1
If Me.ListBox1.Selected(x) = True Then
conta = conta + 1
End If
Next x
If conta = 0 Then
MsgBox «Debe seleccionar un item para copiar en hoja de Excel», vbInformation, «AVISO»
Exit Sub
End If
Set a = Sheets(«Hoja1»)
filaedit = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
a.Cells(filaedit, «A») = ListBox1.List(fila, 0)
a.Cells(filaedit, «B») = ListBox1.List(fila, 1)
a.Cells(filaedit, «C») = ListBox1.List(fila, 2)
a.Cells(filaedit, «D») = ListBox1.List(fila, 3)
a.Cells(filaedit, «E») = ListBox1.List(fila, 4)
a.Cells(filaedit, «F») = ListBox1.List(fila, 5)
a.Cells(filaedit, «G») = ListBox1.List(fila, 6)
a.Cells(filaedit, «H») = ListBox1.List(fila, 7)
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets(«Hoja2»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = «» Then
‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
Me.ListBox1.RowSource = «Hoja2!A2:H» & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 3).Value
If UCase(strg) Like UCase(TextBox1.Value) & «*» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
End If
Next i
Me.ListBox1.ColumnWidths = «20 pt;70 pt;120 pt;80 pt;60 pt;60 pt;60 pt;60pt»
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets(«Hoja2»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = «» Then
‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
Me.ListBox1.RowSource = «Hoja2!A2:H» & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 4).Value
If UCase(strg) Like UCase(TextBox2.Value) & «*» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
End If
Next i
Me.ListBox1.ColumnWidths = «20 pt;70 pt;120 pt;80 pt;60 pt;60 pt;60 pt;60pt»
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets(«Hoja2»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, «$») + 1, InStr(2, uc, «$») – 2)
With Me.ListBox1
.ColumnCount = 8
.ColumnWidths = «20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt»
.RowSource = «Hoja2!A2:» & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub
Sub CargaListbox()
Dim RG As Range, cell As Range
On Error Resume Next
Sheets(«BY879VbDAYRA10iBTOMYIUYT»).Cells.Clear
Sheets(«ARTI»).AutoFilterMode = False
uf = Sheets(«ARTI»).Range(«B» & Rows.Count).End(xlUp).Row
With Sheets(«ARTI»).Range(«B9:K» & uf)
.AutoFilter Field:=2, Criteria1:=»=» & TextBox1 & «*»
Sheets(«BY879VbDAYRA10iBTOMYIUYT»).Cells.Clear
End With
Set RG = Sheets(«ARTI»).Range(«C21», Sheets(«ARTI»).Range(«C21»).End(xlDown)).SpecialCells(xlCellTypeVisible)
RG.CurrentRegion.Copy
Sheets(«BY879VbDAYRA10iBTOMYIUYT»).Range(«a1»).PasteSpecial
uf = Sheets(«BY879VbDAYRA10iBTOMYIUYT»).Range(«B» & Rows.Count).End(xlUp).Row
Me.ListBox1.RowSource = «BY879VbDAYRA10iBTOMYIUYT!A1: J» & uf
TextBox1.SetFocus
End Sub
.
If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.
Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends