Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 23.01.2019, 11:45   #1
chib_sv
Пользователь
 
Регистрация: 15.06.2010
Сообщений: 65
По умолчанию Копирование только нужного дапазона

Добрый день! На листе "Лист1" находиться сводная таблица с наименованием товара. Необходимо скопировать каждый товар на отдельный соответствующий лист. Проблема заключатся в том, что строк в каждом товаре будет всегда разное. (например яблок может быть 50 строк, груш 100 и т.д.)
Вложения
Тип файла: xlsx Книга1.xlsx (10.6 Кб, 46 просмотров)
chib_sv вне форума Ответить с цитированием
Старый 23.01.2019, 14:28   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Sub GoBitch()
    Dim i As Integer
    Dim r As Integer
    Dim sh As Worksheet
    Set sh = Nothing
    
    For i = 3 To 18
        If Cells(i, "A") = vbNullString Then Exit For
        If Cells(i, "A").MergeCells Then
        Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
        sh.Name = "n" & Cells(i, "A")
        r = 2
        Else
            If Not sh Is Nothing Then
                sh.Cells(r, "A") = Cells(i, "A")
                sh.Cells(r, "B") = Cells(i, "B")
                sh.Cells(r, "C") = Cells(i, "C")
                r = r + 1
            End If
        End If
    Next i
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 23.01.2019, 15:08   #3
chib_sv
Пользователь
 
Регистрация: 15.06.2010
Сообщений: 65
По умолчанию

Спасибо за ответ. Вставил ваш код в пример, но не пойму как он работает. По идее нужно что бы таблица Яблоко копировалась на листе яблоко, табл. груша-на листе груша и т.д.
chib_sv вне форума Ответить с цитированием
Старый 23.01.2019, 15:28   #4
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet

     If wb Is Nothing Then Set wb = ThisWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     WorksheetExists = Not sht Is Nothing
 End Function


Sub GoBitch()
    Dim i As Integer
    Dim r As Integer
    Dim sh As Worksheet
    Set sh = Nothing
    
    For i = 3 To 18
        If Cells(i, "A") = vbNullString Then Exit For
        If Cells(i, "A").MergeCells Then
          if not WorksheetExists(cells(i,"A")) then
        Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
        sh.Name = Cells(i, "A")
          else
              set sh = sheets(cells(i,"A"))
          end if
         r = sh.cells(sh.rows.count,"A").end(xlup).row + 1
        Else
            If Not sh Is Nothing Then
                sh.Cells(r, "A") = Cells(i, "A")
                sh.Cells(r, "B") = Cells(i, "B")
                sh.Cells(r, "C") = Cells(i, "C")
                r = r + 1
            End If
        End If
    Next i
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 24.01.2019, 07:43   #5
chib_sv
Пользователь
 
Регистрация: 15.06.2010
Сообщений: 65
По умолчанию

При запуске макроса, ошибка в строке Set sh = Sheets(Cells(i, "A"))
chib_sv вне форума Ответить с цитированием
Старый 24.01.2019, 09:52   #6
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Set sh = Sheets(Cells(i, "A").value)
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 24.01.2019, 10:12   #7
chib_sv
Пользователь
 
Регистрация: 15.06.2010
Сообщений: 65
По умолчанию

Спасибо большое, все работает. Только можно ли поправить код, что бы название фрукта тоже переносилось на соответсвующий лист.
chib_sv вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Копирование только значений диапазона СтаСС Microsoft Office Excel 5 19.01.2019 20:58
Копирование только самых новых файлов AppData Общие вопросы Delphi 33 21.10.2014 15:56
Копирование строк при нахождении нужного слова ma7ter Microsoft Office Excel 1 26.08.2013 08:51
Копирование только значения ячеек (спецвставка) dbutolin Microsoft Office Excel 3 01.06.2011 09:06
Комментарии. Только при пин-коде. Почему работает только 1 пи код? Bushel PHP 1 23.10.2010 18:21