Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 15 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

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

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

Код:
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
__________________
Mailto: media.project@ukr.net
Aleksandr H. вне форума   Ответить с цитированием
Старый 23.01.2019, 16:08   #3
chib_sv
Форумчанин
 
Регистрация: 15.06.2010
Сообщений: 65
Репутация: 10
По умолчанию

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

Код:
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
__________________
Mailto: media.project@ukr.net
Aleksandr H. вне форума   Ответить с цитированием
Старый 24.01.2019, 08:43   #5
chib_sv
Форумчанин
 
Регистрация: 15.06.2010
Сообщений: 65
Репутация: 10
По умолчанию

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

Код:
Set sh = Sheets(Cells(i, "A").value)
__________________
Mailto: media.project@ukr.net
Aleksandr H. вне форума   Ответить с цитированием
Старый 24.01.2019, 11:12   #7
chib_sv
Форумчанин
 
Регистрация: 15.06.2010
Сообщений: 65
Репутация: 10
По умолчанию

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

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Копирование только значений диапазона СтаСС Microsoft Office Excel 5 19.01.2019 21: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


03:53.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru