Buscar datos en un horario y copiar en otra hoja
Mi caso es el que sigue, introduzco una hora inicial y otra hora final (ambas con formato hh:mm) en textBox1 y textbox2 de un formulario.
Lo que busco es que al ejecutar con un botón, la macro busque en la columna "B" de una tabla de la Hoja1 y copie toda la fila que corresponde a esa hora en la Hoja2, esto se debe hacer sólo si el dato de la columna "B" se encuentra entre la hora inicial y final introducida en los textBox.
O sea, si introduzco en textbox1 14:00 y en textbox2 18:00 la macro debiera copiar todos los registros existentes en esas horas, desechando el resto.
Muy agradecido si pudieran ayudarme.
2 Respuestas
[H o l a y bienvenido a TodoExpertos!
No pusiste en cuál fila quieres pegar los datos.
La macro pega a partir de la fila 2. Prueba y me comentas:
Private Sub CommandButton1_Click()
Dim lr As Long, hr As String
'
If TextBox1 = "" Or TextBox2 = "" Then
MsgBox "Captura las horas"
Exit Sub
End If
'
With Sheets("Hoja1")
If .AutoFilterMode Then .AutoFilterMode = False
lr = .Range("B" & Rows.Count).End(3).Row
hr = Format(TimeValue(TextBox2.Value) + TimeValue("00:00:01"), "hh:mm:ss")
.Range("A1:B" & lr).AutoFilter 2, ">=" & TextBox1, xlAnd, "<=" & hr
lr = .Range("B" & Rows.Count).End(3).Row
If lr = 1 Then
MsgBox "No existen registros en esas horas"
Else
.AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("Hoja2").Range("A2")
MsgBox "Registros compiados"
End If
.ShowAllData
End With
End Sub
Hola Dante, siento no haber contestado antes pero como le he dicho a su compañero Federico hasta hoy no he podido comprobar la macro, la suya me da el error "subíndice fuera de intevalo" y dado que soy novato en esto de VBA desconozco la manera de poder implementarla, y menos con filtros avanzados...
Adjunto imagen de la hoja "PEGAR_DATOS"(Hoja1), los datos provienen de un equipo y se pegarán siempre como en la imagen, de esta hoja se han de copiar los datos y pegarlos en la hoja "AUXILIAR_GRAFICOS"(Hoja2).
Las entradas del formulario y formatos de las mismas son las siguientes:
Textbox3 introduce la fecha (dd/mm/yyyy)
textbox1 introduce la hora de inicio (hh:nn)
textbox2 introduce la hora de fin (hh;nn)
La Hoja "AUXILIAR_GRAFICOS" es la hoja donde se deben copiar las filas correspondientes a esa fecha (puede haber hasta 3 o 4 fechas con el mismo horario) y entre esas horas, tiene los mismos encabezados que la hoja PEGAR_DATOS y se deben copiar empezando en la fila 2, efectivamente.
Muy agradecido por su pronta respuesta hace días Dante, espero que no le lleve mucho tiempo implementarlo si se decide a ayudarme de nuevo, un saludo y gracias de todas formas.
Solamente cambia los nombres de las hojas.
Private Sub CommandButton1_Click()
Dim lr As Long, hr As String
'
If TextBox1 = "" Or TextBox2 = "" Then
MsgBox "Captura las horas"
Exit Sub
End If
'
With Sheets("PEGAR_DATOS")
If .AutoFilterMode Then .AutoFilterMode = False
lr = .Range("B" & Rows.Count).End(3).Row
hr = Format(TimeValue(TextBox2.Value) + TimeValue("00:00:01"), "hh:mm:ss")
.Range("A1:B" & lr).AutoFilter 2, ">=" & TextBox1, xlAnd, "<=" & hr
lr = .Range("B" & Rows.Count).End(3).Row
If lr = 1 Then
MsgBox "No existen registros en esas horas"
Else
.AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("AUXILIAR_GRAFICOS").Range("A2")
MsgBox "Registros compiados"
End If
.ShowAllData
End With
End Sub
ola Federico, gracias por su respuesta
Las filas a copiar provienen de la pestaña PEGAR_DATOS y van de la columna A a la M (captura 1).
Entiendo que copiar toda la fila hace la macro mas fácil pero realmente sólo necesitaría las columnas A, B, E, F, J, K, L y M, aunque estén vacías las celdas se han de copiar.
Las filas se han de copiar en la pestaña AUXILIAR_GRAFICOS, actualmente tengo el encabezado de la tabla completa (Captura 2), si la macro sólo pegara las columnas anteriores eliminaría los encabezados no necesarios.
Se han de pegar a partir de la fila 2 Columna A.
Gracias de nuevo, un saludo
Lo mio es un poco mas rudimentario que la respuesta que obtuviste, y la verdad no se como adaptar lo de dante a lo que pedís, tendría que analizarlo mucho tiempo. Pero en fin, creo que esto va a servir:
Private Sub CommandButton1_Click()
Dim Valor1 As Variant, valor2 As Variant
Valor1 = Me.TextBox1.Value
valor2 = Me.TextBox2.Value
Select Case True
Case Valor1 = "" Or valor2 = ""
MsgBox "Complete todos los campos."
Me.TextBox1.SetFocus
'
Case IsDate(Valor1) And IsDate(valor2)
Set ini = Sheets("pegar datos").Range("B:B").Find(Valor1, Range("B1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
Set fin = Sheets("pegar datos").Range("B:B").Find(valor2, Range("B1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
Range(ini, fin.Offset(, -1)). Copy
Sheets("auxiliar_Graficos").Range("A" & Rows. Count).End(xlUp).Offset(1, 0). PasteSpecial
Range(ini. Offset(, 3), fin. Offset(, 4)). Copy
Sheets("auxiliar_Graficos").Range("E" & Rows. Count).End(xlUp).Offset(1, 0). PasteSpecial
Range(ini. Offset(, 8), fin. Offset(, 11)). Copy
Sheets("auxiliar_Graficos").Range("J" & Rows. Count).End(xlUp).Offset(1, 0). PasteSpecial
Application.CutCopyMode = False
'
Case IsNumeric(Valor1) Or IsNumeric(valor2) Or WorksheetFunction.IsText(Valor1) Or WorksheetFunction.IsText(valor2)
MsgBox "ingrese los datos en formato hora."
Me.TextBox1.SetFocus
Case Else
End Select
End Sub