Решение проблемы со списком специальных объектов - ошибка времени выполнения 1004 - PullRequest
1 голос
/ 16 апреля 2019

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

Set tbl2 = ws1.ListObjects("Table2")
Set tbl3 = ws2.ListObjects("Table3")
Set tbl4 = ws3.ListObjects("Table4")
Set tbl5 = ws4.ListObjects("Table5")

For i = 1 To tbl1.ListRows.Count
    tbl1.ListRows(i).Range.Copy

    tbl2.ListRows.Add 1, True
    tbl2.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl2.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value

    tbl3.ListRows.Add 1, True
    tbl3.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl3.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value


    tbl4.ListRows.Add 1, True
    tbl4.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl4.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value

    tbl5.ListRows.Add 1, True
    tbl5.ListRows(1).Range.PasteSpecial xlPasteFormats
    tbl5.ListRows(1).Range.Value = tbl1.ListRows(i).Range.Value

Next i

«Ошибка времени выполнения 1004»: Pastespecial класса диапазона не удалось

Эта ошибка вызывается первой специальной строкой вставки.

Есть идеи, как исправить эту проблему? Я долго искал в стеке, но пока не нашел решения.

Спасибо!

1 Ответ

1 голос
/ 16 апреля 2019

Похоже, вы просто добавляете содержимое tbl1 к куче других таблиц.

Вместо использования буфера обмена скопируйте исходный DataBodyRange в массив 2D-вариантов:

Dim content As Variant
content = tbl1.DataBodyRange.Value

Затем добавьте новую строку к месту назначения:

tbl2.ListRows.Add

и выведите свой 2D-массив в это место:

tbl2.ListRows(tbl2.ListRows.Count).Range.Resize(UBound(content, 1)).Value = content

Промойте и повторите для каждой таблицы назначения ..должно быть почти мгновенно.

...