Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Разнос данных таблицы по листам
 
#1
26.12.2019 13:57:27
Всех приветствую! Пытался найти в существующих темах похожие решения, чтобы адаптировать под свою задачу, но не вышло.
Прошу помощи, существует некий шаблон, который нужно копировать столько раз, сколько заполненных строк в таблице первого листа и заполнять этот созданный шаблон данными из таблицы первого листа, называя лист из заданной ячейки. Я смоделировал то, что мне надо через запись макроса, но не могу зациклить команду на всю таблицу первого листа и перенос данных в шаблон нужно выполнять без формул, а не как у меня с формулами, да и выглядит у меня макрос нагромозжденным.
 
 
 
#2
26.12.2019 14:35:39
Мне кажется у Вас подход немного не правильный, может Вам лучше в этом файле создать шаблон, который будет заполняться в зависимости от выбранных данных, а сохраняться они будут в новом файле в определенной директории.
 
 
 
#3
27.12.2019 00:19:33
Не понял смысла данного решения. В моем случае, я могу менять данные первой таблицы, макрос разносит данные по вкладкам, я вручную удаляю шаблон и первую таблицу, остаются только разнесенные вкладки без формул и без макросов и передаю этот результат неопытному юзеру. Если надо будет разнести такую же таблицу, но с другими данными, я просто переношу ее в исходный файл и проделываю те же действия. Акция разовая  :D  
 
 
 
#4
27.12.2019 07:16:02
Если все верно понял, то как вариант вот так:
Код
Sub t()
x = Sheets("Лист4").Cells(Rows.Count, 1).End(xlUp).Row
y = Sheets("Лист4").Cells(1, Columns.Count).End(xlToLeft).Column
k = 4
kk = 1
For i = 2 To x
    Z = ThisWorkbook.Sheets.Count
    Sheets("Лист1").Copy after:=Sheets(Z)
    ActiveSheet.Name = Sheets("Лист4").Cells(i, 1)
    For ii = 1 To y
        If ii >= 12 And k <> 13 Then
            k = k + 4
            kk = kk - 7
        ElseIf ii > 7 And ii < 12 And k <> 9 Then
            k = k + 5
            kk = kk - 4
        End If
        ActiveSheet.Cells(k, kk) = Sheets("Лист4").Cells(i, ii)
        kk = kk + 1
    Next
    k = 4
    kk = 1
Next
End Sub
 
 
 
#5
27.12.2019 08:44:48
Цитата
Михаил написал:
я вручную удаляю шаблон и первую таблицу, остаются только разнесенные вкладки без формул и без макросов
Чтобы ещё в ручную не удалять макросы тогда может так:
Изменено: msi2102 - 27.12.2019 09:01:18 (заменил файл)
 
 
 
#6
27.12.2019 10:09:03
Цитата
msi2102 написал:
Чтобы ещё в ручную не удалять макросы тогда может так:
Ну да, получается при удалении листа, удаляется и макрос, который был записан на этом листе  ;) , это мне понятно.
Я изменил количество ячеек с которым нужно работать макросу и он мне стал выдавать ошибку "Run-time error '9': Subscript out of range". С 18 ячейками работает, добавляю 19 ячейку, перестает работать. С меньшим количеством ячеек все работает.
Последний вопрос, как сделать, чтобы листы создавались не слева листа с шаблоном, а справа?
 
 
 
#7
27.12.2019 10:11:30
Прикрепите файл
 
 
 
#8
27.12.2019 10:22:59
Прикрепил
 
 
 
#9
27.12.2019 10:32:56
Нужно было ещё поменять диапазон в присвоении массива  
Код
MyArray2 = Range("A2:S" & LR)
для перемещения листов в конце добавьте
Код
Sheets(Array("Лист4", "Лист1")).Move Before:=Sheets(1)
Изменено: msi2102 - 27.12.2019 10:38:31 (заменил файл)
 
 
 
#10
30.12.2019 02:12:11
msi2102, только сейчас посмотрел правки, с диапазоном все понял, а вот перемещение листов конечно стало в конце, но не в том порядке, нужно a1, b1, c1, d1, e1, f1, как это сделать?
 
 
 
#11
30.12.2019 02:15:47
Цитата
GRIM написал:
Если все верно понял, то как вариант вот так:
Все верно, но для меня слишком сложно  :D . Если диапазон таблицы меняется или меняется шаблон, то при подправке макроса у меня появляются сложности. А так в общем все правильно работает.
 
 
 
#12
30.12.2019 09:35:00
Михаил, написал
Цитата
но для меня слишком сложно
Может так будет проще
Код
Sub Raznesti()
Dim i As Long
Dim iLastRow As Long
Dim List4 As Worksheet
  Set List4 = ThisWorkbook.Worksheets("Лист4")
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To iLastRow
    Worksheets("Лист1").Copy After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = List4.Cells(i, "A")
    With List4
      .Range("A" & i & ":G" & i).Copy
      Range("A4").PasteSpecial xlPasteValues
      .Range("H" & i & ":K" & i).Copy
      Range("D9").PasteSpecial xlPasteValues
      .Range("L" & i & ":R" & i).Copy
      Range("A13").PasteSpecial xlPasteValues
    End With
  Next
End Sub
 
 
 
#13
30.12.2019 09:50:51
Цитата
Kuzmich написал:
Может так будет проще
Так все понятно. А как корректно поменять столбец, с которого берется имя для вкладок, а то я меняю букву в строке например так:     ActiveSheet.Name = List4.Cells(i, "F")
и он отрабатывает, а в конце ошибку выбрасывает?
Изменено: Михаил - 30.12.2019 09:58:52
 
 
 
#14
30.12.2019 09:56:17
Цитата
А как корректно поменять столбец, с которого берется имя для вкладок
В строке ActiveSheet.Name = List4.Cells(i, "A") вместо "A" подставьте нужный столбец
 
 
 
#15
30.12.2019 09:57:57
Я так и делаю, а он мне в конце ошибку
 
 
 
#16
30.12.2019 10:00:03
Цитата
а он мне в конце ошибку
Какой столбец подставляете и какая ошибка?
 
 
 
#17
30.12.2019 10:03:00
Подставляю F, ошибка: run-time error 1004: application-defined or object-defined error
 
 
 
#18
30.12.2019 10:09:25
Михаил,
Покажите пример
 
 
 
#19
30.12.2019 10:17:53
Вот
 
 
 
#20
30.12.2019 10:24:35
Михаил,
Все сработало. Создались листы a6-g6
 
 
 
#21
30.12.2019 10:32:16
тогда перезагружу свой комп
 
 
 
#22
31.12.2019 00:21:12
Спасибо большое Kuzmich и msi2102 за помощь! Моя задача, с вашей помощью выполнена на 100 %.
 
 
 
Страницы: 1
Наверх