Изменение жесткой ссылки на нахождения файла импорта

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение жесткой ссылки на нахождения файла импорта (Макросы/Sub)

KolyvanOFF

Дата: Понедельник, 19.01.2015, 08:44 | Сообщение № 1

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

Ранг: Форумчанин

Сообщений: 217

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

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

Excel 2010

Добрый день. Подскажите пожалуйста, как в макросе изменить путь на файл импорта. Макрос создавался на одном ресурсе и при копировании файла макрос ссылается на тот путь который был изначально прописан. Можно ли прописать в макросе чтобы он цеплял файл с определенным названием, но из папки где находится сам файл???
Заранее благодарю.

[vba]

Код

Sub Обновление()
'
' Обновление Макрос
'

'
Columns("A:C").Select
Selection.ClearContents
Workbooks.Open Filename:= _
"U:\Общие файлы\1 группа продаж\Копия Выгрузка клиентской базы.xlsx"
Columns("B:B").Select
Selection.Copy
Windows("Мишень организаций 1 группа продаж.xlsm").Activate
Columns("A:A").Select
ActiveSheet.Paste
Windows("Копия Выгрузка клиентской базы.xlsx").Activate
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Мишень организаций 1 группа продаж.xlsm").Activate
Columns("B:B").Select
ActiveSheet.Paste
Windows("Копия Выгрузка клиентской базы.xlsx").Activate
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Мишень организаций 1 группа продаж.xlsm").Activate
Columns("C:C").Select
ActiveSheet.Paste
Windows("Копия Выгрузка клиентской базы.xlsx").Activate
ActiveWindow.Close
End Sub

[/vba]
[moder]Оформляйте коды тегами (кнопка #)[/moder]

С уважением, Евгений

Ответить

DJ_Marker_MC

Дата: Понедельник, 19.01.2015, 10:15 | Сообщение № 2

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

Ранг: Ветеран

Сообщений: 991

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

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

Excel 2019

А что мешает изменить вот это
[vba]

Код

"U:\Общие файлы\1 группа продаж\Копия Выгрузка клиентской базы.xlsx"

[/vba]
на тот путь который нужно?

А вообще, то Ваш код можно сократить до:

[vba]

Код

Sub Обновление()
Dim MyPath As String
Dim wb1 As String
Dim wb2 As String

Application.ScreenUpdating = False
Application.CutCopyMode = False

wb1 = "Копия Выгрузка клиентской базы.xlsx"
wb2 = "Мишень организаций 1 группа продаж.xlsm"
MyPath = ThisWorkbook.Path & "\" & wb1

Columns("A:C").ClearContents
Workbooks.Open Filename:=MyPath
Columns("B:B").Copy
Workbooks(wb2).Activate
Columns("A:A").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Columns("A:A").Copy
Windows(wb2).Activate
Columns("B:B").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Columns("C:C").Copy
Workbooks(wb2).Activate
Columns("C:C").PasteSpecial xlPasteAll
Workbooks(wb1).Activate

Application.CutCopyMode = True
Application.ScreenUpdating = True

ActiveWindow.Close
End Sub

[/vba]

Хотя если бы вы приложили свои два файла, то возможно было бы еще более упрощенно, а так, то чисто на глаз, но должно работать.

Ответить

KolyvanOFF

Дата: Понедельник, 19.01.2015, 10:33 | Сообщение № 3

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

Ранг: Форумчанин

Сообщений: 217

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

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

Excel 2010

DJ_Marker_MC, сейчас прикреплю.
Я понимаю что путь можно вручную изменить. Но если с общего ресурса файл копируют например на рабочий стол сотрудники, которые в макросах не але! Сидеть и каждому сотруднику настраивать работу макроса - это трата времени.

К сообщению приложен файл: __1__.xlsm (30.0 Kb) · ___.xlsx (19.3 Kb)

С уважением, Евгений

Ответить

KolyvanOFF

Дата: Понедельник, 19.01.2015, 11:00 | Сообщение № 4

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

Ранг: Форумчанин

Сообщений: 217

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

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

Excel 2010

DJ_Marker_MC, спасибо. Реально работает.

С уважением, Евгений

Ответить

DJ_Marker_MC

Дата: Понедельник, 19.01.2015, 11:12 | Сообщение № 5

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

Ранг: Ветеран

Сообщений: 991

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

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

Excel 2019

Немножко подправил

[vba]

Код

Sub Обновление()
Dim MyPath As String
Dim wb1 As String
Dim wb2 As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.CutCopyMode = False

wb1 = Dir(ThisWorkbook.Path & "\" & "*.xlsx")
wb2 = ThisWorkbook.Name
MyName = ThisWorkbook.Path & "\" & wb1

Columns("A:C").ClearContents
Workbooks.Open Filename:=MyName
Columns("B:B").Copy
Workbooks(wb2).Activate
Columns("A:A").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Columns("A:A").Copy
Windows(wb2).Activate
Columns("B:B").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Columns("C:C").Copy
Workbooks(wb2).Activate
Columns("C:C").PasteSpecial xlPasteAll
Workbooks(wb1).Close

Application.CutCopyMode = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[/vba]

Но важно чтоб Файлы лежали в одной папке и рядом с ними не было других файлов .xlsx

Ответить

RAN

Дата: Понедельник, 19.01.2015, 11:56 | Сообщение № 6

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

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

Сообщений: 5660

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

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

2010

[vba]

Код

Sub Макрос()
      Application.ScreenUpdating = False
      Set wb = ThisWorkbook
      Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\Копия Выгрузка клиентской базы.xlsx")
      wb.Sheets(1).Columns("A:C").Clear
      wb1.Sheets(1).Columns("A:C").Copy wb.Sheets(1).Columns("A")
      wb.Sheets(1).Columns("B").Cut
      wb.Sheets(1).Columns("A").Insert Shift:=xlToRight
      wb1.Close False
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Понедельник, 19.01.2015, 12:10

Ответить

DJ_Marker_MC

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

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

Ранг: Ветеран

Сообщений: 991

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

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

Excel 2019

[offtop] RAN, пытался/пыхтел я с этим Set, а он мне "Ошибка... Ошибка")))
Но теперь вижу что делал не правильно, хотя цель была такого же кода)))[/offtop]

Ответить

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