Добрый день многоуважаемые ГУРУ!!! Долго искал готовое решение для моего случая, но такого не нашлось увы. Поэтому я тут, и думаю Вам не составит труда решить мою задачку. Суть вопроса: Лист "Бригада" заполнен данными с листа "Сбор" (вручную) именно так данные должны ложиться на этот и другие листы при нажатии на кнопку "Заполнить". Имя листа =А1, А1 использоварь для поиска. Лист "Сбор" как видно постоянно обновляется и дополняется поэтому кол-во строк его будет около 18 000. Кол-во работников (листов) примерно 100 человек. Это все к тому, что бы не очень сильно утяжелять документ. Можно рассмотреть также и иное решение задачи т.е. не через кнопку а например обновлением связей при раздельном размещении Работников и листа СБОР
Добрый день многоуважаемые ГУРУ!!! Долго искал готовое решение для моего случая, но такого не нашлось увы. Поэтому я тут, и думаю Вам не составит труда решить мою задачку. Суть вопроса: Лист "Бригада" заполнен данными с листа "Сбор" (вручную) именно так данные должны ложиться на этот и другие листы при нажатии на кнопку "Заполнить". Имя листа =А1, А1 использоварь для поиска. Лист "Сбор" как видно постоянно обновляется и дополняется поэтому кол-во строк его будет около 18 000. Кол-во работников (листов) примерно 100 человек. Это все к тому, что бы не очень сильно утяжелять документ. Можно рассмотреть также и иное решение задачи т.е. не через кнопку а например обновлением связей при раздельном размещении Работников и листа СБОРKorobkow
Любая задача имеет решение. Предлагаю вариант из вложения, рабочие кнопки на каждом листе. Что думаете?
[vba]
Код
Option Explicit Option Compare Text
Sub Personal_Download()
Dim X As Long, A As Long, B As Long Dim shtX As Worksheet
Set shtX = ThisWorkbook.Worksheets("Сбор") A = 3
Application.ScreenUpdating = False With ActiveSheet
B = .Cells(.Rows.Count, 1).End(xlUp).Row If B > 2 Then .Range(.Cells(3, 1), .Cells(B, 15)).Value = ""
For X = 1 To shtX.Cells(shtX.Rows.Count, 1).End(xlUp).Row If shtX.Cells(X, 2).Value = .Name Then .Cells(A, 1).Value = shtX.Cells(X, 1).Value .Cells(A, 2).Value = "'" & shtX.Cells(X, 3).Value .Cells(A, 3).Value = shtX.Cells(X, 4).Value .Cells(A, 4).Value = "'" & shtX.Cells(X, 5).Value .Cells(A, 7).Value = shtX.Cells(X, 6).Value A = A + 1 End If Next X
End With Application.ScreenUpdating = True
End Sub
[/vba]
Korobkow, здравствуйте.
Любая задача имеет решение. Предлагаю вариант из вложения, рабочие кнопки на каждом листе. Что думаете?
[vba]
Код
Option Explicit Option Compare Text
Sub Personal_Download()
Dim X As Long, A As Long, B As Long Dim shtX As Worksheet
Set shtX = ThisWorkbook.Worksheets("Сбор") A = 3
Application.ScreenUpdating = False With ActiveSheet
B = .Cells(.Rows.Count, 1).End(xlUp).Row If B > 2 Then .Range(.Cells(3, 1), .Cells(B, 15)).Value = ""
For X = 1 To shtX.Cells(shtX.Rows.Count, 1).End(xlUp).Row If shtX.Cells(X, 2).Value = .Name Then .Cells(A, 1).Value = shtX.Cells(X, 1).Value .Cells(A, 2).Value = "'" & shtX.Cells(X, 3).Value .Cells(A, 3).Value = shtX.Cells(X, 4).Value .Cells(A, 4).Value = "'" & shtX.Cells(X, 5).Value .Cells(A, 7).Value = shtX.Cells(X, 6).Value A = A + 1 End If Next X
Rioran, УПС рано я обрадовался! макрос затрагивает все пространство с А по О столбец - чистит, это не допустимо. Нужно чтоб заполнялись только столбцы ABCDG в остальных стоят другие формулы
Rioran, УПС рано я обрадовался! макрос затрагивает все пространство с А по О столбец - чистит, это не допустимо. Нужно чтоб заполнялись только столбцы ABCDG в остальных стоят другие формулыKorobkow
Тут он очищает все, анужно очистить только 1,2,3,4,7 столбец, и то только там где данные есть т.е. до первой пустой ячейки типо както вот но чуть подругому - ограничить надо первой пустой [vba]
Тут он очищает все, анужно очистить только 1,2,3,4,7 столбец, и то только там где данные есть т.е. до первой пустой ячейки типо както вот но чуть подругому - ограничить надо первой пустой [vba]