Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Создание кучи листов., Макрос по созданию листов
 
Добрый день
У меня такая задача:
На первом листе есть таблица со значениями. Второй лист - рыба
Нужно скопировать рыбу и скопировать туда значения с первого листа (ячеку А1 первого листа в ячейку D2 только что скопированной рыбы), перейти к следующей строке... и так до первой пустой строки

С помощью макросомейкера я создал нечто, что копирует листы и копирует туда ячейчи.
Код
(Sheets("AAAA";).Select
        Sheets("AAAA";).Copy After:=Sheets(4)
        Sheets("Sheet1";).Select
        Range("A2";).Select
        Selection.Copy
        Sheets("АААА (2)";).Select
        Range("A6:C6";).Select
        ActiveSheet.Paste)

Как теперь заставить это повторяться до первой пустой строки?
Или это надо спрашивать в разделе "Работа"? =(
Можете ткнуть носом, где подобный случай разжован.
Спасибо
 
Лучше всего For Each
Код
For Each cCurr In Range(<диапазон>)
 ...
If cCurr="" Then 
 Exit For
Else
 Range("A1").Copy WorkSheets(<Новый лист>).Range("D2")
End If
 ...
Next cCurr
Неизлечимых болезней нет, есть неизлечимые люди.
 
Код
Sheets("Рыбы").Select
lLastRowSheetsRibi = Cells(Rows.Count, 1).End(xlUp).Row

В переменную lLastRowSheetsRibi занесется значение последней заполненной строки на листе "РЫБЫ". От этого можно дальше плясать
 
Если кому интересно, то вот это:
Код
Sub Macro1()

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
        Worksheets("TEMPLATE (2)";).Range("A6";).past
End If
Next cCurr
End Sub

не работает. Копирует шит, но не копирует ячейки.... =(
Плюс ещё понял, что для второго листа надо брать значения со второй строки, а это уже какой то космос для меня
Всем спасибо за желание помочь.
Видимо, это очень сложно для моего осознания.... буду копировать сотни листов в ручную.... =)
 
Задача плёвая... Но вот честно пытался вникнуть в эту кучу ошибок... Не, я лучше схожу пообедаю, пока тут появится нормальный файл с задачей и кодом....
 
попробуйте так    
Код
Sheets("TEMPLATE").Copy After:=Sheets(4)
Worksheets("Sheet1").Range("A1").Copy Range("A6")
Неизлечимых болезней нет, есть неизлечимые люди.
 
TheBestOfTheBest, заработало вот в таком виде:
Код
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

Я уже собой доволен.
Сложно это изменить, что бы в первый скопированный лист копировалась ячейка из первой строки, на второй - из второй.... т.д.

То что тут ошибок много, я прикрасно понимаю... ибо далёк от этого. Просто встала такая задача (создать кучу листов с разными значениями), и я думаю, хватит ли мне сил хоть чуть чуть автомтизировать сей процесс.. =)
Изменено: trn09 - 23 Апр 2015 15:14:48
 
Попробуйте. Не проверял естественно
Код
    For Each cCurr In Range("A1:A10")
        If cCurr = "" Then
            Exit For
        Else
            Sheets("TEMPLATE").Copy After:=Sheets(4)
            cCurr.Copy Sheets(5).Range("A6")
        End If
    Next cCurr

 
Hugo, Спасибо большое, что не оставили в трудной минуте и помогли найти решение данной задачи! =)
Страницы: 1
Читают тему (гостей: 1)