Question

我希望你能帮助我。我对vba并不擅长，过去你的社区一直都很有帮助。我必须每月运行一份报告，显示我的团队在一个咨询项目上工作的时间。附有丝网印刷 report

大约有1,000行，我需要将星期结束字段中具有相同日期的行移动到新选项卡。在上面的示例中，结果将是复制到两个选项卡的数据，其中一个工作表上有3/23个记录，另一个上有3/30个记录。我发现宏观样本将根据输入复制数据，但不是相同的，报告每季度更新一次，列出9个不同的周。这将给我一个良好的开端

Answer 1

Sub TransferReport()

'Check each date
 For Each DateEnd In Sheet15.Columns(4).Cells    'Change Sheet15 refer to your report tab
    If DateEnd.Value = "" Then Exit Sub 'Stop program if no date
    If IsDate(DateEnd.Value) Then
        shtName = Format(DateEnd.Value, "dd.mm")    'Change date to valid tab name

        On Error GoTo errorhandler  'if no Date Sheet, go to errorhandler to create new tab
        If Worksheets(shtName).Range("A2").Value = "" Then
           DateEnd.EntireRow.Copy Destination:=Worksheets(shtName).Range("A2")
           Worksheets(shtName).Range("A1:J1").Columns.AutoFit
        Else
            DateEnd.EntireRow.Copy Destination:=Worksheets(shtName).Range("A1").End(xlDown).Offset(1)
        End If
    End If
Next

Exit Sub
errorhandler:
Sheets.Add After:=Sheets(Sheets.Count) 'Create new tab
ActiveSheet.Name = shtName  'Name tab with date
Sheet15.Rows(1).EntireRow.Copy Destination:=ActiveSheet.Rows(1) 'Copy heading to new tab
Resume
End Sub

Excel VBA宏根据日期选择数据并将其移动到新选项卡

1 个答案: