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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование значений между листавми по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование значений между листавми по условию (Макросы/Sub)
Копирование значений между листавми по условию
ТемТемыч Дата: Пятница, 15.01.2021, 15:16 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Добрый день, можете помочь в решение задачи. Суть есть файл excel на листе ТЗ в колонке А вносится информация по контр агентам не уникальные значения, создано несколько листов, с иенами контрагентов (это переменное значение и будут изменяться наименование). При помощи кода информация берется из ячейки А1 каждого листа. В чем заключается проблема. Нужен макрос который из таблички на листе ТЗ выделял все строки всех контрагентов и копировал информацию в одноименные листы. %) Заранее спасибо.
К сообщению приложен файл: 6771031.xlsm(20.0 Kb)
 
Ответить
СообщениеДобрый день, можете помочь в решение задачи. Суть есть файл excel на листе ТЗ в колонке А вносится информация по контр агентам не уникальные значения, создано несколько листов, с иенами контрагентов (это переменное значение и будут изменяться наименование). При помощи кода информация берется из ячейки А1 каждого листа. В чем заключается проблема. Нужен макрос который из таблички на листе ТЗ выделял все строки всех контрагентов и копировал информацию в одноименные листы. %) Заранее спасибо.

Автор - ТемТемыч
Дата добавления - 15.01.2021 в 15:16
Kuzmich Дата: Пятница, 15.01.2021, 16:14 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 597
Репутация: 126 ±
Замечаний: 0% ±

Excel 2003
Цитата
на листе ТЗ выделял все строки всех контрагентов и копировал информацию в одноименные листы

[vba]
Код
Sub TZ()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim Sht As Worksheet
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To iLastRow
Set Sht = ThisWorkbook.Worksheets("" & Cells(i, "A") & "")
With Sht
iLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Range("A" & i & ":D" & i).Copy .Cells(iLR, "A")
End With
Next
End Sub
[/vba]


Сообщение отредактировал Kuzmich - Пятница, 15.01.2021, 16:15
 
Ответить
Сообщение
Цитата
на листе ТЗ выделял все строки всех контрагентов и копировал информацию в одноименные листы

[vba]
Код
Sub TZ()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim Sht As Worksheet
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To iLastRow
Set Sht = ThisWorkbook.Worksheets("" & Cells(i, "A") & "")
With Sht
iLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Range("A" & i & ":D" & i).Copy .Cells(iLR, "A")
End With
Next
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 15.01.2021 в 16:14
ТемТемыч Дата: Суббота, 16.01.2021, 12:07 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Спасибо hands . Работает, но не до конца. 2 раза прогрузило и вылезла ошибка "Run-Time error '9':

И понял свою не доработку:
1. вставлять на листы нужно с с адреса B10 или можно сделать так, чтобы я мог менять куда должна вставится первая строка на листе
2. Как сделать так чтобы новые заменяли старые т.е. обновлялись ( сейчас добавляются)
 
Ответить
СообщениеСпасибо hands . Работает, но не до конца. 2 раза прогрузило и вылезла ошибка "Run-Time error '9':

И понял свою не доработку:
1. вставлять на листы нужно с с адреса B10 или можно сделать так, чтобы я мог менять куда должна вставится первая строка на листе
2. Как сделать так чтобы новые заменяли старые т.е. обновлялись ( сейчас добавляются)

Автор - ТемТемыч
Дата добавления - 16.01.2021 в 12:07
Kuzmich Дата: Суббота, 16.01.2021, 14:41 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 597
Репутация: 126 ±
Замечаний: 0% ±

Excel 2003
Цитата
1. вставлять на листы нужно с с адреса B10

Макрос в стандартный модуль, запускать при активном листе ТЗ
[vba]
Код
Sub TZ()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim FirstRow As Long
Dim Sht As Worksheet
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    FirstRow = 10
For i = 2 To iLastRow
If SheetExists("" & Cells(i, "A") & "") Then
    Set Sht = ThisWorkbook.Worksheets("" & Cells(i, "A") & "")
  With Sht
    iLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      If iLR < 10 Then iLR = FirstRow
    Range("A" & i & ":D" & i).Copy .Cells(iLR, "A")
  End With
Else
   MsgBox "В книге нет листа с именем: " & Cells(i, "A")
End If
Next
End Sub

Function SheetExists(WSName) As Boolean
  On Error Resume Next
  SheetExists = Sheets(WSName).Name = WSName
  On Error GoTo 0
End Function
[/vba]

Цитата
2. Как сделать так чтобы новые заменяли старые

По какому столбцу проверять?
 
Ответить
Сообщение
Цитата
1. вставлять на листы нужно с с адреса B10

Макрос в стандартный модуль, запускать при активном листе ТЗ
[vba]
Код
Sub TZ()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim FirstRow As Long
Dim Sht As Worksheet
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    FirstRow = 10
For i = 2 To iLastRow
If SheetExists("" & Cells(i, "A") & "") Then
    Set Sht = ThisWorkbook.Worksheets("" & Cells(i, "A") & "")
  With Sht
    iLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      If iLR < 10 Then iLR = FirstRow
    Range("A" & i & ":D" & i).Copy .Cells(iLR, "A")
  End With
Else
   MsgBox "В книге нет листа с именем: " & Cells(i, "A")
End If
Next
End Sub

Function SheetExists(WSName) As Boolean
  On Error Resume Next
  SheetExists = Sheets(WSName).Name = WSName
  On Error GoTo 0
End Function
[/vba]

Цитата
2. Как сделать так чтобы новые заменяли старые

По какому столбцу проверять?

Автор - Kuzmich
Дата добавления - 16.01.2021 в 14:41
ТемТемыч Дата: Вторник, 19.01.2021, 16:53 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Kuzmich, Добрый день. Еще раз спасибо за код. Я единственное не могу понять до конца, как поменять чтобы информация не вырезалась, а только копировалась
 
Ответить
СообщениеKuzmich, Добрый день. Еще раз спасибо за код. Я единственное не могу понять до конца, как поменять чтобы информация не вырезалась, а только копировалась

Автор - ТемТемыч
Дата добавления - 19.01.2021 в 16:53
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование значений между листавми по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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