是否有一个宏有条件地将行复制到另一个工作表？

Question

在Excel 2003中是否有一个宏或方法有条件地将行从一个工作表复制到另一个工作表？

我正在通过Web查询将SharePoint中的数据列表拉入Excel中的空白工作表,然后我想将特定月份的行复制到特定工作表(例如,将所有7月数据从SharePoint工作表复制到7月工作表,从SharePoint工作表到Jun工作表的所有June数据,等等.

样本数据

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

这不是一次性的练习.我正在尝试整理一个仪表板,我的老板可以从SharePoint获取最新数据并查看每月结果,因此它需要能够始终如一地完成并干净地组织它.

Answer 1

这是有效的:它的设置方式我从直接窗格调用它,但你可以轻松创建一个sub(),每个月调用一次MoveData,然后只调用sub.

您可能希望添加逻辑以在复制完所有数据后对其进行排序

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