Excel - Creando macro para buscar y copiar

Problema

Tengo una hoja de cálculo con todas las fechas diferentes con los datos correspondientes en su fila. Hay muchas filas con la misma fecha y quiero crear una macro para buscar todas las mismas fechas y copiarlas y pegarlas en la hoja 2 para poder ordenarlas

ejemplo:

 27-sep 27-sep 27-sep 28-sep 28-sep 01-oct 01-oct

No tengo idea de cómo crear una macro; sin embargo, he buscado en todo el Internet para encontrar una que pudiera modificar para insertar mis propios datos, y esto es lo que he encontrado.

 Sub SearchForString () Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute 'Iniciar búsqueda en la fila 6 LSearchRow = 6' Comience a copiar datos en la fila 110 en Sheet2 (variable de contador de fila) LCopyToRow = 110 While Len (Range ("A" & CStr (LSearchRow)). Valor)> 0 'Si el valor en la columna A = "27-Sep", copie la fila completa a la Hoja2 Si Rango ("A" & CStr (LSearchRow)). Valor = "27 = Sep" Luego 'Seleccione la fila en la Hoja1 para copiar Filas (CStr (LSearchRow) y ":" & CStr (LSearchRow)). Seleccione Selection.Copy' Pegue la fila en la Hoja 2 en la siguiente fila Hojas ("Sheet2"). Seleccione Rows (CStr (LCopyToRow) & ":" & CStr (LCopyToRow)). Seleccione ActiveSheet.Paste 'Mover el contador a la siguiente fila LCopyToRow = LCopyToRow + 1' Regrese a la Hoja1 para continuar buscando hojas ("Sheet1"). Seleccione Fin Si LSearchRow = LSearchRow + 1 Wend 'Posición en la celda A109 Application.CutCopyMode = False Range ("A109"). Seleccione MsgBox "Se han copiado todos los datos coincidentes." Salir Sub Err_Execute: MsgBox "Ocurrió un error". End Sub

Solución

Estoy dando dos macros "test" y "deshacer"

La hoja de muestra es así (hoja 1): no es necesario ordenar

fecha data1 data2

3/1/2010 37 1

3/2/2010 65 96

3/3/2010 48 46

3/2/2010 78 54

5/5/2010 3 38

3/2/2010 83 58

3/3/2010 45 78

Prueba la macro "prueba" y ve la hoja 2.

si quieres volver a probar

1.run "deshacer"

entonces

2.rung "prueba"

las macros son

 Prueba secundaria () Dim r As Range, r1 As Range, r2 As Range Dim c2 As Range, consulte las hojas de trabajo de Range As Range ("sheet1"). Activate Set r = Range (Range ("A1"), Range ("A1") .End (xlDown)) Set r1 = Range ("a1"). End (xlDown) .Offset (5, 0) r.AdvancedFilter action: = xlFilterCopy, copytorange: = r1, unique: = True Set r2 = Range (r1 .Offset (1, 0), r1.End (xlDown)) para cada c2 In r2 If WorksheetFunction.CountIf (r, c2)> 1 Then With Range ("A1"). CurrentRegion .AutoFilter field: = 1, Criteria1: = c2.Value .Cells.SpecialCells (xlCellTypeVisible) .Copy Worksheets ("sheet2"). Cells (Rows.Count, "A"). End (xlUp) .Offset (1, 0) .PasteSpecial End With End If ActiveSheet. AutoFilterMode = False Next c2 Worksheets ("sheet2"). Active Do Set cfind = ActiveSheet.Cells.Find (what: = "date", lookat: = xlWhole, after: = Range ("A2")) Si cfind Is Nothing Then Salir Do cfind.EntireRow.Delete Loop Worksheets ("sheet1"). Range ("A1"). EntireRow.Copy Worksheets ("sheet2"). Range ("A1"). PasteSpecial Application.CutCopyMode = False End Sub Subdodo ( ) Hojas de trabajo ("hoja 2"). Células. Clear End Sub