Копирование из книги, у которой иногда меняется название

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

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

Копирование из книги, у которой иногда меняется название (Макросы/Sub)

stns

Дата: Воскресенье, 30.07.2023, 11:28 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2013

Здравствуйте! Просьба о помощи. Я новичок, как смог так и написал макрос для извлечения данных из одной книги, в другую - Трассовка ЮКМ (2 нитка), сохранение там в определенных столбцах для дальнейшего раскидывания данных по таблице с помощью формул. Соглашусь, что макрос выглядит громоздко и можно было это все оформить быстро и по другому, но как смог так и сделал, главное работает.
Вопрос в том, что так и не смог найти элементарного – в названии книги, из которой извлекаются данные, регулярно меняется дата и может меняться часть текста. Вставляю в папку этот присылаемый мне файл сам день через день. Пытался с помощью dim, но так и не получилось, не смог понять куда чего ставить. И также у этой книги может меняться расширение .xls .xlsx .xlsm. Еще не получилось прикрутить формулу ЕСЛИ(ЕЧИСЛО(ПОИСК("AN";C3));"A";"O") в столбец G, поставил вручную.
PS И еще, иногда требуется извлечение так, чтобы все располагалось снизу вверх, как бы наоборот – вверху стояло сначала нижнее значение и так далее. И так по всем столбцам, кроме столбца А – нумерации.
Старался максимально понятно выразиться. Буду благодарен за решение этого вопроса.

К сообщению приложен файл: dlja_foruma.rar (478.4 Kb)

Ответить

СообщениеЗдравствуйте! Просьба о помощи. Я новичок, как смог так и написал макрос для извлечения данных из одной книги, в другую - Трассовка ЮКМ (2 нитка), сохранение там в определенных столбцах для дальнейшего раскидывания данных по таблице с помощью формул. Соглашусь, что макрос выглядит громоздко и можно было это все оформить быстро и по другому, но как смог так и сделал, главное работает.
Вопрос в том, что так и не смог найти элементарного – в названии книги, из которой извлекаются данные, регулярно меняется дата и может меняться часть текста. Вставляю в папку этот присылаемый мне файл сам день через день. Пытался с помощью dim, но так и не получилось, не смог понять куда чего ставить. И также у этой книги может меняться расширение .xls .xlsx .xlsm. Еще не получилось прикрутить формулу ЕСЛИ(ЕЧИСЛО(ПОИСК("AN";C3));"A";"O") в столбец G, поставил вручную.
PS И еще, иногда требуется извлечение так, чтобы все располагалось снизу вверх, как бы наоборот – вверху стояло сначала нижнее значение и так далее. И так по всем столбцам, кроме столбца А – нумерации.
Старался максимально понятно выразиться. Буду благодарен за решение этого вопроса.

Автор - stns
Дата добавления - 30.07.2023 в 11:28

stns

Дата: Понедельник, 31.07.2023, 04:03 | Сообщение № 2

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2013

Упростил свой вопрос и книги с данными. Хотябы такую задачу разрешить.

Из "Книга1 31.07.2023.xlsx" копируем в "Книга2" через один столбец. Нельзя ли упростить макрос?
И если файл потом станет называться "Книга1 01.08.2023", а потом "Книга1 15.08.2023", как заставить работать макрос?

[vba]

Код

Sub test()

'Открываем файл с которого нужно скопировать данные
Workbooks.Open Filename:="C:\Макрос\Книга1 31.07.2023.xlsx"
'Скопировать нужный диапазон в открывшейся книге на листе 1
Workbooks("Книга1 31.07.2023.xlsx").Worksheets("Лист1").Range("A8:A25").Copy
'Активируем нужную нам книгу
Workbooks("Книга2.xlsm").Activate
'Выделяем и вставляем скопированные данные в ячейку A3
ActiveWorkbook.Worksheets("Лист1").Range("A3").Select
ActiveSheet.Paste

Workbooks("Книга1 31.07.2023.xlsx").Worksheets("Лист1").Range("C8:C25").Copy
Workbooks("Книга2.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("B3").Select
ActiveSheet.Paste

Workbooks("Книга1 31.07.2023.xlsx").Worksheets("Лист1").Range("E8:E25").Copy
Workbooks("Книга2.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("C3").Select
ActiveSheet.Paste

Workbooks("Книга1 31.07.2023.xlsx").Worksheets("Лист1").Range("G9:G25").Copy
Workbooks("Книга2.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("D3").Select
ActiveSheet.Paste

Workbooks("Книга1 31.07.2023.xlsx").Worksheets("Лист1").Range("I9:I25").Copy
Workbooks("Книга2.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("E3").Select
ActiveSheet.Paste

Workbooks("Книга1 31.07.2023.xlsx").Worksheets("Лист1").Range("K8:K25").Copy
Workbooks("Книга2.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("F3").Select
ActiveSheet.Paste
End Sub

[/vba]

Код

[/vba]stns

К сообщению приложен файл: kniga2.xlsm (19.5 Kb) · kniga1_31_07_2023.xlsx (10.8 Kb)

Сообщение отредактировал Serge_007 - Понедельник, 31.07.2023, 08:34

Ответить

СообщениеУпростил свой вопрос и книги с данными. Хотябы такую задачу разрешить.

Из "Книга1 31.07.2023.xlsx" копируем в "Книга2" через один столбец. Нельзя ли упростить макрос?
И если файл потом станет называться "Книга1 01.08.2023", а потом "Книга1 15.08.2023", как заставить работать макрос?

[vba]

Код

[/vba]

Автор - stns
Дата добавления - 31.07.2023 в 04:03

Nic70y

Дата: Понедельник, 31.07.2023, 09:38 | Сообщение № 3

Группа: Друзья

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

Сообщений: 9005

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

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

Excel 2010

[vba]

Код

Sub test()
UserForm1.Show
End Sub

[/vba]

апдэйт, исправил
[vba]

Код

Private Sub UserForm_Activate()
    Dim arr()
    a = TextBox1.Value
    b = Dir(a & "\*.xls*")
    c = ThisWorkbook.Name
    n = 0
    i = 1
    Do While b <> ""
        ReDim Preserve arr(n)
        If b <> c Then
            arr(n) = b
            n = n + 1
            i = i + 1
        End If
        b = Dir
    Loop
    ListBox1.List = arr()
End Sub
Private Sub CommandButton1_Click()
    x = ListBox1.ListIndex
    If x = -1 Then
        MsgBox "Файл не выбран!"
    Else
        a = TextBox1.Value
        b = ListBox1.Value
        Workbooks.Open Filename:=a & b
        Range("C5:C25,E5:E25,G5:G25,I5:I25,K5:K25").Copy ThisWorkbook.Sheets("Лист1").Range("a3")
        Workbooks(b).Close False
        Unload UserForm1
    End If
End Sub

[/vba]

К сообщению приложен файл: 8490259.gif (15.3 Kb) · 8151144.xlsm (21.2 Kb)

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Понедельник, 31.07.2023, 10:09

Ответить

stns

Дата: Понедельник, 31.07.2023, 12:04 | Сообщение № 4

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2013

Nic70y, спасибо большое! Примерно понятно. Пытался сам это сделать, стопорится на ListBox1.List = arr(), пытаюсь скачать из вашего сообщения файл 1533819.xlsm, написано - такой страницы не существует. Нельзя ли продублировать.