是否有宏来有条件地将行复制到另一个工作表？ [英] Is there a macro to conditionally copy rows to another worksheet?

问题描述

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

Is there a macro or a way to conditionally copy rows from one worksheet to another in Excel 2003?

我从SharePoint通过一个web查询到Excel中的空白工作表，然后我想将特定月份的行复制到特定工作表（例如，从SharePoint工作表到七月工作表的所有七月数据，从SharePoint工作表到六月的所有六月数据工作表等）。

I'm pulling a list of data from SharePoint via a web query into a blank worksheet in Excel, and then I want to copy the rows for a particular month to a particular worksheet (for example, all July data from a SharePoint worksheet to the Jul worksheet, all June data from a SharePoint worksheet to Jun worksheet, etc.).

示例数据

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中提取最新的数据，并看到每月的结果，所以它需要能够一直做到这一点，并整理它。

It's not a one-off exercise. I'm trying to put together a dashboard that my boss can pull the latest data from SharePoint and see the monthly results, so it needs to be able to do it all the time and organize it cleanly.

推荐答案

这样工作：它的设置方式我从立即窗格调用它，但你可以很容易地创建一个sub

This works: The way it's set up I called it from the immediate pane, but you can easily create a sub() that will call MoveData once for each month, then just invoke the sub.

您可能需要添加逻辑以在每月数据全部复制后对其进行排序。

You may want to add logic to sort your monthly data after it's all been copied

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

这篇关于是否有宏来有条件地将行复制到另一个工作表？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！