Макрос Excel VBA для выбора данных на основе даты и перемещения их на новую вкладку - PullRequest
Новая
       23

Макрос Excel VBA для выбора данных на основе даты и перемещения их на новую вкладку

0 голосов
/ 06 июня 2018

Я надеюсь, что вы можете мне помочь.Я не очень хорош в VBA, и ваше сообщество оказало большую помощь в прошлом.Я должен ежемесячно составлять отчет с указанием часов, отработанных для моей команды в рамках консалтингового проекта.Прикрепленный снимок экрана отчет

есть около 1000 строк, и мне нужно переместить строки с одинаковой датой в поле окончания недели на новую вкладку.в приведенном выше примере результатом будут данные, скопированные на две вкладки с 3/23 записями на одном листе и 3/30 на другом.Я нашел образцы макросов, которые будут копировать данные на основе входных данных, но не совпадают, и отчет обновляется ежеквартально с указанием 9 различных недель.Это даст мне хорошее начало

1 Ответ

0 голосов
/ 06 июня 2018 
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
...