Как автоматизировать открытие новых листов

Question

У меня проблемы с автоматизацией Excel / VBA. На главном листе с именем «РЕЗЮМЕ» (в настоящий момент во всей книге только один лист) у меня есть несколько столбцов, таких как:

Я хочу рабочую книгу чтобы автоматически создать новый лист, когда в столбце F (ДАТА) будет добавлена ​​новая строка с новой, уникальной датой, и я хочу, чтобы эти новые листы обновлялись со всеми данными, имеющими эту дату (и эти новые листы должны иметь эту дату как имя). До сих пор, к счастью, vcoolio я нашел образец , который создает новые листы на основе столбца , но когда я переделываю код для своих нужд, что-то не так. Создаются новые листы, но в них копируются только заголовки без данных. Это, наверное, какой-то неправильный код с моей стороны.

Кроме того, этот код должен выполняться каждый раз сам, и моя цель - сделать так, чтобы код автоматически запускался, когда я просто набираю в столбце F какую-то новую дату (формат DATE - просто строка)

Вот как я переделал код:

Sub CreateNewShtsTransferData()



 Dim sht As Worksheet

 Dim lr As Long, i As Long

 Dim ID As Object

 Dim key As Variant

 Dim ws As Worksheet



Set sht = Arkusz1                                        '---here is the name of sheet, in English version it is sht = Sheet1---

Set ID = CreateObject("Scripting.Dictionary")            '---here is creating new place where the dates will be stored?---



 Application.ScreenUpdating = True

 Application.DisplayAlerts = True



lr = sht.Range("F" & Rows.Count).End(xlUp).Row           '---here is counting the dates?---



For i = 2 To lr

 If Not ID.Exists(sht.Range("F" & i).Value) Then         '---here is checking if the ID dictionary now contains the specific date, to avoid duplicates?---

 ID.Add sht.Range("F" & i).Value, 1                      '---here is added the new date to the ID dictionary? (which is next used to make new sheets)---

 End If

Next i

For Each key In ID.keys

 If Not Evaluate("ISREF('" & key & "'!F1)") Then         '---here is checking if there is a sheet named by a dates from ID dictionary?---

 Worksheets.Add(After:=Sheets(Sheets.Count)).Name = key  '---here is adding new sheet based on a name?---'

 End If



Set ws = Worksheets(CStr(key))

sht.Range("F1:F" & lr).AutoFilter 1, key                 '---here is filtering data? to copy then filtered data to new sheet? this is under above "For Each"?---

 sht.[F1].CurrentRegion.Copy ws.[A1]                     '---here is mention about starting copying in cell A1?---
 ws.Columns.AutoFit

 sht.[F1].AutoFilter

Next key



sht.Select

Application.CutCopyMode = False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

MsgBox "All done!", vbExclamation



End Sub

Любая помощь приветствуется!