Помогите с заполнением листа =/

[Lama Under Cover]

Здравствуйте!

Имеется блок данных в диапазоне F3:F13. При обновлении значений листа данный блок копируется в ближайший незанятый справа, и так до конца листа.

Как сделать так, чтобы при заполнении листа до конца листа (столбца XFD) данный блок продолжал копироваться, начиная со следующей пустой строки (F14, шаг 11).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastFreeCol As Long
     
   Application.EnableEvents = False
   Application.DisplayStatusBar = False
   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
   
   Application.Calculation = xlCalculationAutomatic
      
   Range("F3:F13").Select
   Selection.Copy
         LastFreeCol = Cells(3, Columns.Count).End(xlToLeft).Column + 1
     Cells(3, LastFreeCol).Select
     
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Application.CutCopyMode = False
    
        
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

P.S. Сам тестировал цикл For i = 3 to 104856 Step 11(где i - номер строки) и внутри While LastCol < последний столбец, однако выдавал ошибку.

Файл приложен

[Step_UA]

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r&, c&
    Application.EnableEvents = False
    r = 3 + 11 * ((Cells(Rows.Count, 6).End(xlUp).Row - 3) \ 11)
    With Cells(r, Columns.Count)
        If .Value = Empty Then
            c = .End(xlToLeft).Column + 1
        Else
            r = r + 11: c = 6
        End If
   End With
   [f3:f13].Copy Cells(r, c)
    Application.EnableEvents = True
End Sub

[Lama Under Cover]

Чудно было бы еще два момента понять:
1) не могу понять принцип работы

Сообщение от Step_UA

r = 3 + 11 * ((Cells(Rows.Count, 6).End(xlUp).Row - 3) \ 11)b

;
2) а также то, как изменить метод копирования с копирования формул до копирования значений в Вашем примере.

Но программа работает. Спасибо!


P.S. Но при этом. Увы. Испытал макрос, вроде бы работать должен, но при обновлении листа через программку почему то не робит..

При этом в случае, когда делаю вручную - то все ок.

[Aleksandr H.]

Сообщение от Lama Under Cover

P.S. Но при этом. Увы. Испытал макрос, вроде бы работать должен, но при обновлении листа через программку почему то не робит..

На форуме была обработка изменений через DDE.

[Hugo121]

Сообщение от Lama Under Cover

P.S. Но при этом. Увы. Испытал макрос, вроде бы работать должен, но при обновлении листа через программку почему то не робит..

При этом в случае, когда делаю вручную - то все ок.

Так ведь ни слова не сказали что обновлять будете не вручную.
С DDE - отдельная песня. Можно отслеживать пересчёт завязанной формулы, или изменение связанного текстбокса/листбокса.

[Step_UA]

Сообщение от Lama Under Cover

не могу понять принцип работы

Находит номер строки для копирования: 3, 14, 25 ....

как изменить метод копирования с копирования формул до копирования значений

' Заменить следующую строку
[f3:f13].Copy Cells(r, c)
' 1 вариант
Cells(r, c).resize(11).value=[f3:f13].value
' 2 вариант
[f3:f13].Copy
Cells(r, c).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

[Lama Under Cover]

Задача решена на 90%.

Нашел где-то через текст бокс, вывод через DDE работает, однако требуется вставить время каждого изменения.

При вставке ТДАТА() через сцепку в текстбокс макрос записи изменений не работает. Добавил Тдата отдельно, однако по какой то причине код, который должен сохранять значения времени в соседний столбец в виде значений а не формул - не работает.

Private Sub Worksheet_Change(ByVal Target As Range)
    Range("C2:C100000").Select
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
    
End Sub

Файл прикрепил.