Добрый день Если коротко, то: На первом листе есть таблица с данными. Есть второй лист - РЫБА (образец). Необходимо скопировать рыбу и вставить в неё значения из первой строки. Потом скопировать ещё раз рыбу и вставить в неё значения из второй строки. и так до конца таблицы. С помощью макросмейкера удалось создаь НЕЧТО, что копирует листы и копирует туда значения:
[vba]
Код
For Each cCurr In Range("A1:A10")
If cCurr = "" Then Exit For Else Sheets("TEMPLATE").Select Sheets("TEMPLATE").Copy After:=Sheets(4) Sheets("Sheet1").Select Range("A1").Select Selection.Copy Sheets("TEMPLATE (2)").Select Range("A6:C6").Select ActiveSheet.Paste End If Next cCurr
[/vba] Подскажите, сложно переделать его, что бы он менял строки (сейчас он копирует значения из ячейки А1, а для второго шита надо уже из ячейки А2)
Если это очень сложно и долго для понимания новичку, скажите, что бы я забросил эту идею и начал всё делать в ручную, не теряя на это время =) Спасибо [moder]Код следует оформлять тегами (кнопка #). Исправила[/moder]
Добрый день Если коротко, то: На первом листе есть таблица с данными. Есть второй лист - РЫБА (образец). Необходимо скопировать рыбу и вставить в неё значения из первой строки. Потом скопировать ещё раз рыбу и вставить в неё значения из второй строки. и так до конца таблицы. С помощью макросмейкера удалось создаь НЕЧТО, что копирует листы и копирует туда значения:
[vba]
Код
For Each cCurr In Range("A1:A10")
If cCurr = "" Then Exit For Else Sheets("TEMPLATE").Select Sheets("TEMPLATE").Copy After:=Sheets(4) Sheets("Sheet1").Select Range("A1").Select Selection.Copy Sheets("TEMPLATE (2)").Select Range("A6:C6").Select ActiveSheet.Paste End If Next cCurr
[/vba] Подскажите, сложно переделать его, что бы он менял строки (сейчас он копирует значения из ячейки А1, а для второго шита надо уже из ячейки А2)
Если это очень сложно и долго для понимания новичку, скажите, что бы я забросил эту идею и начал всё делать в ручную, не теряя на это время =) Спасибо [moder]Код следует оформлять тегами (кнопка #). Исправила[/moder]trn09
Где-то на другом форуме я уже отвечал. Потеряли или не подошло?
обсуждалось тут: http://www.planetaexcel.ru/forum....e550835 Он не переберает строки при копировании =( [moder]Исправляйте 1-е замечание модератора! И вставьте ссылку на форум, где обсуждался этот вопрос[/moder]
Где-то на другом форуме я уже отвечал. Потеряли или не подошло?
обсуждалось тут: http://www.planetaexcel.ru/forum....e550835 Он не переберает строки при копировании =( [moder]Исправляйте 1-е замечание модератора! И вставьте ссылку на форум, где обсуждался этот вопрос[/moder]trn09
Сообщение отредактировал trn09 - Пятница, 24.04.2015, 11:14
Чем докажете? Голословное утверждение. Вот чуть другой код - т.к. тут соизволили показать пример. [vba]
Код
Sub COPY_() 'не используйте служебные имена! Application.ScreenUpdating = False For Each ccurr In Sheets(1).Range("A1:A5") If ccurr = "" Then Exit For Else Sheets("TEMPLATE").COPY After:=Sheets(2) Sheets(3).Range("A6") = ccurr End If Next ccurr End Sub
[/vba]
Чем докажете? Голословное утверждение. Вот чуть другой код - т.к. тут соизволили показать пример. [vba]
Код
Sub COPY_() 'не используйте служебные имена! Application.ScreenUpdating = False For Each ccurr In Sheets(1).Range("A1:A5") If ccurr = "" Then Exit For Else Sheets("TEMPLATE").COPY After:=Sheets(2) Sheets(3).Range("A6") = ccurr End If Next ccurr End Sub
Извиняюсь за наглость, но как сделать что бы листы в конец добавлялись.... Sheets("TEMPLATE").COPY After:=Sheets(2) - добавляет после второго. В итоге получается лист5, лист4, лист3, лист2, лист 1, а желательно: лист1, лист2, лист3, лист4, лист5
Извиняюсь за наглость, но как сделать что бы листы в конец добавлялись.... Sheets("TEMPLATE").COPY After:=Sheets(2) - добавляет после второго. В итоге получается лист5, лист4, лист3, лист2, лист 1, а желательно: лист1, лист2, лист3, лист4, лист5trn09
Manyasha, Заработало! Спасибо! =) Hugo, Спасибо. Я, в силу своей ексельной безграмотности, немого не так всё понял, но вы оказались правы! Ещё раз спасибо всем!
Manyasha, Заработало! Спасибо! =) Hugo, Спасибо. Я, в силу своей ексельной безграмотности, немого не так всё понял, но вы оказались правы! Ещё раз спасибо всем!trn09
trn09, Вроде разобрался, как это работает... но при попытке увеличить количество ячеек всё поломал: [vba]
Код
Sub COPY()
Application.ScreenUpdating = False For Each ccurr In Sheets(1).Range("A1:A5") For Each REV In Sheets(1).Range("B1:B5") If ccurr = "" Then Exit For Else Sheets("TEMPLATE").COPY After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Range("A6") = ccurr Sheets(Sheets.Count).Range("D6") = REV End If
Next ccurr Next REV End Sub
[/vba]
Как можно это исправить?
trn09, Вроде разобрался, как это работает... но при попытке увеличить количество ячеек всё поломал: [vba]
Код
Sub COPY()
Application.ScreenUpdating = False For Each ccurr In Sheets(1).Range("A1:A5") For Each REV In Sheets(1).Range("B1:B5") If ccurr = "" Then Exit For Else Sheets("TEMPLATE").COPY After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Range("A6") = ccurr Sheets(Sheets.Count).Range("D6") = REV End If
Ой. Это я оказывается цикл в цикле сделал. и при пяти ячейках и двадцати листах он уже повис.... Надо что бы он скопировал лист, вставил туда значения с первого листа (в 2 ячейки из двух столбцов) и после этого перешёл к копированию следущего шита (вставляя в него 2 ячейки из двух столбцов следующей строки). Как? =(
Ой. Это я оказывается цикл в цикле сделал. и при пяти ячейках и двадцати листах он уже повис.... Надо что бы он скопировал лист, вставил туда значения с первого листа (в 2 ячейки из двух столбцов) и после этого перешёл к копированию следущего шита (вставляя в него 2 ячейки из двух столбцов следующей строки). Как? =(trn09
Сообщение отредактировал trn09 - Пятница, 24.04.2015, 15:17
Sub Copy_rng() Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lr With Sheets(1) If .Cells(i, 1) = "" And .Cells(i, 2) = "" Then 'если А1 и В1 пустые, выходим, правильно? Exit For Else Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Range("A6") = .Cells(i, 1) Sheets(Sheets.Count).Range("D6") = .Cells(i, 2) End If End With Next i End Sub
[/vba]
Не называйте макросы служебными именами! Hugo Вам уже об этом писал.
trn09, проверяйте
[vba]
Код
Sub Copy_rng() Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lr With Sheets(1) If .Cells(i, 1) = "" And .Cells(i, 2) = "" Then 'если А1 и В1 пустые, выходим, правильно? Exit For Else Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Range("A6") = .Cells(i, 1) Sheets(Sheets.Count).Range("D6") = .Cells(i, 2) End If End With Next i End Sub
[/vba]
Не называйте макросы служебными именами! Hugo Вам уже об этом писал.Manyasha
Manyasha, Да, всё верно! Всё правильно! Всё работает! Надеюсь, вас не очень напрягли мои проблемы. Про название макросов запомнил. Больше не буду так называть. Спасибо. И хороших выходных.
Manyasha, Да, всё верно! Всё правильно! Всё работает! Надеюсь, вас не очень напрягли мои проблемы. Про название макросов запомнил. Больше не буду так называть. Спасибо. И хороших выходных.trn09