Gibt es ein Makro zum bedingten Kopieren von Zeilen in ein anderes Arbeitsblatt?

Question

Gibt es ein Makro oder eine Möglichkeit, Zeilen in Excel 2003 von einem Arbeitsblatt zu einem anderen bedingt zu kopieren?

Ich ziehe eine Liste von Daten aus SharePoint über eine Web-Abfrage in ein leeres Arbeitsblatt in Excel, und dann möchte ich die Zeilen für einen bestimmten Monat in ein bestimmtes Arbeitsblatt kopieren (z. B. alle Juli-Daten von a SharePoint-Arbeitsblatt zum Jul-Arbeitsblatt, alle Juni-Daten von einem SharePoint-Arbeitsblatt zum Jun-Arbeitsblatt usw.).

Beispieldaten

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 

Es ist keine einmalige Angelegenheit. Ich versuche, ein Dashboard zu erstellen, dass mein Chef die neuesten Daten aus SharePoint abrufen kann und die monatlichen Ergebnisse sehen kann, also muss es in der Lage sein, es ständig zu tun und sauber zu organisieren.

Answer 1

Wenn dies nur eine einmalige Übung ist, können Sie als einfachere Alternative Filter auf Ihre Quelldaten anwenden und dann die gefilterten Zeilen kopieren und in Ihr neues Arbeitsblatt einfügen.

Answer 2

Dies ist zum Teil Pseudo-Code, aber Sie werden wie etwas wollen:

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 3

Dies funktioniert: Die Art und Weise festgelegt ist bis ich es aus dem unmittelbaren Fensterbereich genannt, aber Sie können einen Unter einfach erstellen (), die MoveData für jeden Monat einmal aufruft, dann rufen Sie einfach das Sub auf.

Sie können Logik hinzufügen möchten Ihre monatlichen Daten zu sortieren, nachdem sie alle

kopiert worden ist

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

Hier ist eine andere Lösung, die zum Vergleich einige VBA integrierten Datumsfunktionen und speichert alle aktuellen Daten in einem Array verwendet , die eine bessere Leistung geben kann, wenn Sie eine große Datenmenge erhalten:

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 5

Die Art, wie ich dies manuell tun würde, ist:

• Verwendung Daten - Autofilter
• Tragen Sie einen benutzerdefinierten Filter auf der Basis eines Datumsbereich
• Kopieren Sie die gefilterten Daten an den betreffenden Monat Blatt
• Wiederholen Sie für jeden Monat

der folgenden Liste ist Code, diesen Prozess zu tun über VBA.

Es hat den Vorteil, monatliche Datenabschnitte statt einzelner Zeilen zu verarbeiten. Dies kann zu einer schnelleren Verarbeitung für größere Datenmengen führen.

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