Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перенос строк по значению - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос строк по значению (Макросы/Sub)
Перенос строк по значению
Kirill94 Дата: Четверг, 20.12.2018, 09:17 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день! У меня есть книга, в ней 4 листа, 1 лист это главная остальные 3 побочные. Мне нужно что бы, если я поставил на других листах в колонке факт какое либо число и нажал на кнопку сформировать, то подтянулись значение в таблицу на главной. Ну т.е. если есть значение в стобце факт, то подтягивать строку с этими значениями в главную таблицу.
К сообщению приложен файл: 6873466.xlsx(18.2 Kb)


Сообщение отредактировал Kirill94 - Четверг, 20.12.2018, 09:18
 
Ответить
СообщениеДобрый день! У меня есть книга, в ней 4 листа, 1 лист это главная остальные 3 побочные. Мне нужно что бы, если я поставил на других листах в колонке факт какое либо число и нажал на кнопку сформировать, то подтянулись значение в таблицу на главной. Ну т.е. если есть значение в стобце факт, то подтягивать строку с этими значениями в главную таблицу.

Автор - Kirill94
Дата добавления - 20.12.2018 в 09:17
StoTisteg Дата: Четверг, 20.12.2018, 17:13 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1157
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Так по кнопке или по факту изменений на листе?


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеТак по кнопке или по факту изменений на листе?

Автор - StoTisteg
Дата добавления - 20.12.2018 в 17:13
Kirill94 Дата: Пятница, 21.12.2018, 02:40 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
По кнопке
 
Ответить
СообщениеПо кнопке

Автор - Kirill94
Дата добавления - 21.12.2018 в 02:40
StoTisteg Дата: Пятница, 21.12.2018, 10:50 | Сообщение № 4
Группа: Авторы
Ранг: Старожил
Сообщений: 1157
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
А с тем, что там уже есть, что делать?


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеА с тем, что там уже есть, что делать?

Автор - StoTisteg
Дата добавления - 21.12.2018 в 10:50
StoTisteg Дата: Пятница, 21.12.2018, 11:31 | Сообщение № 5
Группа: Авторы
Ранг: Старожил
Сообщений: 1157
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Пока с ранее заполненным не делает ничего, если надо удалять — раскомментируйте закомментированные строки.[vba]
Код
Sub Butt()

   Dim sh As Worksheet
   Dim rwf As Long, i As Long, s As String
    
   On Error Resume Next
   ActiveSheet.ListObjects(1).Unlist
   rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
   'Range(Rows(15), Rows(rwf - 1)).Delete
   'rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
   For Each sh In Worksheets
      If sh.Index > 1 Then
         s = sh.Name
         For i = 2 To sh.Cells(1, 1).End(xlDown).Row
            If Not IsEmpty(sh.Cells(i, 12)) Then
               sh.Rows(i).Copy Destination:=Rows(rwf)
               rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
         Next i
      End If
   Next sh
   If rwf > 15 Then ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(14, 1), Cells(rwf - 1, 13)), , xlYes).Name = "Заказ"

End Sub
[/vba]
К сообщению приложен файл: 6844098.xlsm(27.6 Kb)


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеПока с ранее заполненным не делает ничего, если надо удалять — раскомментируйте закомментированные строки.[vba]
Код
Sub Butt()

   Dim sh As Worksheet
   Dim rwf As Long, i As Long, s As String
    
   On Error Resume Next
   ActiveSheet.ListObjects(1).Unlist
   rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
   'Range(Rows(15), Rows(rwf - 1)).Delete
   'rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
   For Each sh In Worksheets
      If sh.Index > 1 Then
         s = sh.Name
         For i = 2 To sh.Cells(1, 1).End(xlDown).Row
            If Not IsEmpty(sh.Cells(i, 12)) Then
               sh.Rows(i).Copy Destination:=Rows(rwf)
               rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
         Next i
      End If
   Next sh
   If rwf > 15 Then ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(14, 1), Cells(rwf - 1, 13)), , xlYes).Name = "Заказ"

End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 21.12.2018 в 11:31
StoTisteg Дата: Воскресенье, 23.12.2018, 00:14 | Сообщение № 6
Группа: Авторы
Ранг: Старожил
Сообщений: 1157
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Пардон, наврал и контрольку забыл убрать:[vba]
Код
Sub Butt()

Dim sh As Worksheet
Dim rwf As Long, i As Long
    
On Error Resume Next
ActiveSheet.ListObjects(1).Unlist
rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
'Range(Rows(15), Rows(rwf - 1)).Delete
'rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each sh In Worksheets
    If sh.Index > 1 Then
        For i = 2 To sh.Cells(1, 1).End(xlDown).Row
            If Not IsEmpty(sh.Cells(i, 12)) Then
            sh.Rows(i).Copy Destination:=Rows(rwf)
            rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
        Next i
    End If
Next sh
If rwf > 15 Then ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(14, 1), Cells(rwf - 1, 13)), , xlYes).Name = "Заказ"

End Sub
[/vba]


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеПардон, наврал и контрольку забыл убрать:[vba]
Код
Sub Butt()

Dim sh As Worksheet
Dim rwf As Long, i As Long
    
On Error Resume Next
ActiveSheet.ListObjects(1).Unlist
rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
'Range(Rows(15), Rows(rwf - 1)).Delete
'rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each sh In Worksheets
    If sh.Index > 1 Then
        For i = 2 To sh.Cells(1, 1).End(xlDown).Row
            If Not IsEmpty(sh.Cells(i, 12)) Then
            sh.Rows(i).Copy Destination:=Rows(rwf)
            rwf = Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
        Next i
    End If
Next sh
If rwf > 15 Then ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(14, 1), Cells(rwf - 1, 13)), , xlYes).Name = "Заказ"

End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 23.12.2018 в 00:14
Kirill94 Дата: Среда, 26.12.2018, 04:06 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо
 
Ответить
СообщениеСпасибо

Автор - Kirill94
Дата добавления - 26.12.2018 в 04:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос строк по значению (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!