Macro para buscar por fecha y fin mes en una columna y copie rango de columnas a otra hoja
Espero me puedan ayudar por favor.. Resulta que necesito filtrar datos de la hoja1 a la hoja 2..
Ejemplo en la hoja2 en la celda A1 ingreso una fecha "01/02/019" y esta me busque en la hoja1 en la columna G desde la fila 3 ahí están las fechas.. La búsqueda me es solo ese mes o que el código sea entre fecha que seria 01/02/2019 hasta el ultimo día de ese mes.. Luego de buscar las fechas copies las filas correspondientes de las siguientes columnas A, F, J, S a la hoja 2 desde la fila 4 hacia abajo..
2 Respuestas
Prueba este código, adapta lo que sea necesario:
Sub FindFecha()
Dim rCell As Range, rRng As Range
Dim Sht1UF As Long, Sht2NF As Long
Dim Sht1 As Worksheet, Sht2 As Worksheet
Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")
Sht1UF = Sht1.Range("G" & Rows.Count).End(xlUp).Row
Set rRng = Sht1.Range("G1:G" & Sht1UF)
For Each rCell In rRng.Cells
If DateDiff("m", Sht2.Range("A1").Value, rCell.Value) = 0 Then
Sht2NF = Sht2.Range("A" & Rows.Count).End(xlUp).Row + 1
'llenando datos en hoja 2
Sht2.Cells(Sht2NF, 1).Value = Sht1.Cells(rCell.Row, 1).Value
Sht2.Cells(Sht2NF, 6).Value = Sht1.Cells(rCell.Row, 6).Value
Sht2.Cells(Sht2NF, 10).Value = Sht1.Cells(rCell.Row, 10).Value
Sht2.Cells(Sht2NF, 19).Value = Sht1.Cells(rCell.Row, 19).Value
End If
Next rCell
End Subel código ve si las dos fechas pertenecen al mismo mes.
Andy M.
Prueba esta macro, usa un autofiltro para hacer una copia masiva de datos, primero lee la fecha y calcula el fin de mes, con estas dos condiciones filtra copia lo filtrado y luego separa en las filas que requieres
Sub filtrarycopiar()
fecha_inicial = CDbl(CDate(Sheets("hoja2").Range("a1")))
fecha_final = CDbl(CDate(WorksheetFunction.EoMonth(fecha_inicial, 0)))
filas = Sheets("hoja1").Range("g3").CurrentRegion.Rows.Count
Set datos = Sheets("hoja1").Range("a3:z3").Resize(filas)
With Sheets("hoja1")
If .AutoFilterMode = True Then .AutoFilterMode = False
End With
With datos
.AutoFilter field:=7, Criteria1:=" >=" & fecha_inicial, _
Operator:=xlAnd, Criteria2:="<=" & fecha_final
Sheets("hoja1").Select
.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("hoja2").Select
Range("ah3").PasteSpecial
Set copia = Range("ah3").CurrentRegion
With copia
Union(.Columns(1), .Columns(6), .Columns(9), .Columns(19)).Copy
End With
filas2 = Range("a3").CurrentRegion.Rows.Count
Range("a4").Rows(filas2 + 1).PasteSpecial xlPasteAll
copia.Clear
End With
Set copia = Nothing: Set datos = Nothing
End Sub