Макрос сбора данных

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос сбора данных (Макросы/Sub)

Макрос сбора данных

EnicheV

Дата: Вторник, 10.09.2019, 12:39 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Sub Собираем_данные_по_сотрудникам()
Sheets("ОБЩИЙ").Select
ActiveWindow.SelectedSheets.Delete
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ОБЩИЙ"
Sheets("ОБЩИЙ").Select
Sheets("ОБЩИЙ").Move Before:=Sheets(1)
Dim iRng As Range
Dim iRngAddress As String, oAwb As String, oFile
Dim lLastRow As Long, lLastRowMyBook As Long
Dim iLastColumn As Integer
Dim Str() As String

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = "*.*"
.Title = "Выберите файлы"
If .Show = False Then Exit Sub
For Each oFile In .SelectedItems
Workbooks.OpenText Filename:=oFile
oAwb = Dir(oFile, vbDirectory)

Application.ScreenUpdating = False
Workbooks(oAwb).Activate
For Each Sheet In Sheets
Sheet.Activate
lLastRow = Cells(1, 1).SpecialCells(xlLastCell).Row
iLastColumn = Cells(1, 1).SpecialCells(xlLastCell).Column
lLastRowMyBook = ThisWorkbook.Worksheets(1).Cells(100, 1).SpecialCells(xlLastCell).Row
iRngAddress = Range(Cells(lLastRowMyBook, 1), Cells(lLastRowMyBook + lLastRow, iLastColumn)).Address
Sheet.Range(Cells(1, 1), Cells(lLastRow, iLastColumn)).Copy Destination:=ThisWorkbook.Worksheets(1).Range(iRngAddress)

Next Sheet
Workbooks(oAwb).Close False
Next oFile

End With

Application.ScreenUpdating = True
MsgBox "ГОТОВО!"
End Sub

Помогите решить вопрос чтобы макрос собирал данные не со всей открываемой книги, а только с Листа 1
ХЕЛП!!!

Ответить

китин

Дата: Вторник, 10.09.2019, 13:06 | Сообщение № 2

Группа: Модераторы

Ранг: Экселист

Сообщений: 7014

Репутация: 1073 ±

Замечаний: 0% ±

Excel 2007;2010;2016

EnicheV, - Прочитайте Правила форума
- Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 100кб согласно п.3 Правил форума
- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос сбора данных (Макросы/Sub)

Страница 1 из 1
1