Автоматизация копирования из разных файлов в один

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

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

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Автоматизация копирования из разных файлов в один (Формулы/Formulas)

sodcover

Дата: Среда, 10.08.2022, 22:39 | Сообщение № 1

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

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

Сообщений: 7

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

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

Добрый вечер. Помогите автоматизировать работу. Имеется очень много файлов excel скаченных сайта рп5. В них содержаться данные о погоде за три месяца на разных метеостанциях. Я копирую эти данные, начиная с восьмой строки и вставляю в другой файл, где происходит расчет необходимого показателя. Файлы с рп5 однотипные, копирую один и тот же диапазон, вставляю их в файл, где идет расчет на один и тот же лист под названием "Вводные данные". Если делать по одному в ручную, то очень долго получается. Файл для расчета пришлось упростить, оригинал уж очень много весит.

К сообщению приложен файл: 25956.15.06.202.xls (153.5 Kb) · 26069.15.06.202.xls (167.0 Kb) · 6161351.xls (26.0 Kb)

Ответить

pechkin

Дата: Четверг, 11.08.2022, 07:44 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 329

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

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

2003

Здравствуйте! Когда Вы скачиваете файлы с сайта их названия "до точки" (после точки, как я понимаю, дата начальных данных) всегда одни и те же ( в примере 25956 и 26069) или изменяются? Себе для работы решал подобную задачу вот так примерно... Создаете папку для скачанных файлов(в примере - Погода) Делаете список файлов "до точки" в примере на отдельном листе Выбираете название на листе Вводные данные и на кнопку...[vba]

Код

Sub Окрыть_()
Dim dv
Dim nazv As String
Dim x As String
x = [A1] 'короткое название
Range("B1,A2").ClearContents
Range("A8:AA450").ClearContents
  sFolder = "D:\Погода\"
   sFiles = Dir(sFolder & x & "*.xls")
     Do While sFiles <> ""
         Workbooks.Open sFolder & sFiles
         sFiles = Dir
     Loop
     If ActiveWorkbook.Name = "Raschet.xls" Then
     MsgBox "ФАЙЛ  НЕ НАЙДЕН!"
     Exit Sub
     End If
         nazv = ActiveWorkbook.Name
    dv = Range("A1")
    Range(Cells(8, 1), Cells(450, 27)).Copy
      Windows("Raschet.xls").Activate
      Rows("8:8").Insert Shift:=xlDown
      Range("A2").Value = dv
      Range("B1").Value = nazv
    Application.CutCopyMode = False
Workbooks(Range("B1").Value).Close (False)
End Sub

[/vba]

К сообщению приложен файл: Raschet.xls (382.5 Kb)

Сообщение отредактировал pechkin - Четверг, 11.08.2022, 09:22

Ответить

sodcover

Дата: Четверг, 11.08.2022, 22:02 | Сообщение № 3

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

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

Сообщений: 7

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

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

Спасибо за помощь, буду пробовать.

Ответить

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