excel vba - ultima - ¿Hay una macro para copiar filas condicionalmente a otra hoja de trabajo?

seleccionar hoja excel vba

Question

¿Hay una macro o una forma de copiar condicionalmente las filas de una hoja de trabajo a otra en Excel 2003?

Estoy sacando una lista de datos de SharePoint a través de una consulta web en una hoja de cálculo en blanco en Excel, y luego quiero copiar las filas de un mes en particular a una hoja de cálculo en particular (por ejemplo, todos los datos de julio de una hoja de cálculo de SharePoint a la Hoja de trabajo de Jul, todos los datos de junio de una hoja de trabajo de SharePoint a la hoja de trabajo de Jun, etc.).

Data de muestra

Date - Project - ID - Engineer
8/2/08 - XYZ - T0908-5555 - JS
9/4/08 - ABC - T0908-6666 - DF
9/5/08 - ZZZ - T0908-7777 - TS

No es un ejercicio de una sola vez. Intento armar un tablero para que mi jefe pueda extraer los últimos datos de SharePoint y ver los resultados mensuales, así que debe poder hacerlo todo el tiempo y organizarlo limpiamente.

Answer 1

Esto es parcialmente pseudocódigo, pero querrás algo como:

rows = ActiveSheet.UsedRange.Rows
n = 0

while n <= rows
  if ActiveSheet.Rows(n).Cells(DateColumnOrdinal).Value > ''8/1/08'' AND < ''8/30/08'' then
     ActiveSheet.Rows(n).CopyTo(DestinationSheet)
  endif
  n = n + 1
wend

Answer 2

Aquí hay otra solución que usa algunas de las funciones de fecha incorporadas de VBA y almacena todos los datos de fecha en una matriz para comparar, lo que puede proporcionar un mejor rendimiento si obtiene una gran cantidad de datos:

Public Sub MoveData(MonthNum As Integer, FromSheet As Worksheet, ToSheet As Worksheet)
    Const DateCol = "A" ''column where dates are store
    Const DestCol = "A" ''destination column where dates are stored. We use this column to find the last populated row in ToSheet
    Const FirstRow = 2 ''first row where date data is stored
    ''Copy range of values to Dates array
    Dates = FromSheet.Range(DateCol & CStr(FirstRow) & ":" & DateCol & CStr(FromSheet.Range(DateCol & CStr(FromSheet.Rows.Count)).End(xlUp).Row)).Value
    Dim i As Integer
    For i = LBound(Dates) To UBound(Dates)
        If IsDate(Dates(i, 1)) Then
            If Month(CDate(Dates(i, 1))) = MonthNum Then
                Dim CurrRow As Long
                ''get the current row number in the worksheet
                CurrRow = FirstRow + i - 1
                Dim DestRow As Long
                ''get the destination row
                DestRow = ToSheet.Range(DestCol & CStr(ToSheet.Rows.Count)).End(xlUp).Row + 1
                ''copy row CurrRow in FromSheet to row DestRow in ToSheet
                FromSheet.Range(CStr(CurrRow) & ":" & CStr(CurrRow)).Copy ToSheet.Range(DestCol & CStr(DestRow))
            End If
        End If
    Next i
End Sub

Answer 3

Esto funciona: la forma en que está configurado lo llamé desde el panel inmediato, pero puedes crear fácilmente un sub () que llamará MoveData una vez por cada mes, y luego solo invocar el sub.

Es posible que desee agregar lógica para ordenar sus datos mensuales después de que todo haya sido copiado

Public Sub MoveData(MonthNumber As Integer, SheetName As String)

Dim sharePoint As Worksheet
Dim Month As Worksheet
Dim spRange As Range
Dim cell As Range

Set sharePoint = Sheets("Sharepoint")
Set Month = Sheets(SheetName)
Set spRange = sharePoint.Range("A2")
Set spRange = sharePoint.Range("A2:" & spRange.End(xlDown).Address)
For Each cell In spRange
    If Format(cell.Value, "MM") = MonthNumber Then
        copyRowTo sharePoint.Range(cell.Row & ":" & cell.Row), Month
    End If
Next cell

End Sub

Sub copyRowTo(rng As Range, ws As Worksheet)
    Dim newRange As Range
    Set newRange = ws.Range("A1")
    If newRange.Offset(1).Value <> "" Then
        Set newRange = newRange.End(xlDown).Offset(1)
        Else
        Set newRange = newRange.Offset(1)
    End If
    rng.Copy
    newRange.PasteSpecial (xlPasteAll)
End Sub

Answer 4

Si esto es solo un ejercicio de una sola vez, como una alternativa más fácil, podría aplicar filtros a sus datos de origen, y luego copiar y pegar las filas filtradas en su nueva hoja de trabajo.

Answer 5

La forma en que haría esto manualmente es:

• Usar datos - Autofiltro
• Aplicar un filtro personalizado basado en un rango de fechas
• Copie los datos filtrados en la hoja del mes correspondiente
• Repita para cada mes

A continuación se enumera el código para realizar este proceso a través de VBA.

Tiene la ventaja de manejar secciones mensuales de datos en lugar de filas individuales. Lo que puede dar como resultado un procesamiento más rápido para conjuntos de datos más grandes.

    Sub SeperateData()

    Dim vMonthText As Variant
    Dim ExcelLastCell As Range
    Dim intMonth As Integer

   vMonthText = Array("January", "February", "March", "April", "May", _
 "June", "July", "August", "September", "October", "November", "December")

        ThisWorkbook.Worksheets("Sharepoint").Select
        Range("A1").Select

    RowCount = ThisWorkbook.Worksheets("Sharepoint").UsedRange.Rows.Count
''Forces excel to determine the last cell, Usually only done on save
    Set ExcelLastCell = ThisWorkbook.Worksheets("Sharepoint"). _
     Cells.SpecialCells(xlLastCell)
''Determines the last cell with data in it


        Selection.EntireColumn.Insert
        Range("A1").FormulaR1C1 = "Month No."
        Range("A2").FormulaR1C1 = "=MONTH(RC[1])"
        Range("A2").Select
        Selection.Copy
        Range("A3:A" & ExcelLastCell.Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Calculate
    ''Insert a helper column to determine the month number for the date

        For intMonth = 1 To 12
            Range("A1").CurrentRegion.Select
            Selection.AutoFilter Field:=1, Criteria1:="" & intMonth
            Selection.Copy
            ThisWorkbook.Worksheets("" & vMonthText(intMonth - 1)).Select
            Range("A1").Select
            ActiveSheet.Paste
            Columns("A:A").Delete Shift:=xlToLeft
            Cells.Select
            Cells.EntireColumn.AutoFit
            Range("A1").Select
            ThisWorkbook.Worksheets("Sharepoint").Select
            Range("A1").Select
            Application.CutCopyMode = False
        Next intMonth
    ''Filter the data to a particular month
    ''Convert the month number to text
    ''Copy the filtered data to the month sheet
    ''Delete the helper column
    ''Repeat for each month

        Selection.AutoFilter
        Columns("A:A").Delete Shift:=xlToLeft
 ''Get rid of the auto-filter and delete the helper column

    End Sub