Макрос, который тянет информацию из другого файла

Пользователь

Сообщений: 24 Регистрация: 21.07.2014

21.07.2014 20:06:10

Добрый день!

Подскажите, плиз, как написать макрос, который будет находиться в одном файле, а инфу тянуть из другого:
1. В исходнике(1ый файл) несколько столбцов (10), мне нужна информация в 3х из них
2. В конечном файле(2ой файл) 3 столбца с такими же названиями
3. Нужно что бы при нажатии макрос обновлял(не добавлял) конечный файл данными из 1го, желательно даже не открывая его.
4. ссылки и обновить связи, ВПР не подходят, т.к. кол-во строк будет всегда меняться, ссылки виде "0" или неверных значений не нужны, нужен чистый файл без ссылок.
5. Есть вот такой вот кусок макроса, возможно неправильный и обрубленный:

Код

Sub Кнопка2 Щелкнуть ()
'CORP budget
      Workbooks.Open Filename:= _
        "\\file-server\Fin_Analisys\BUDGET\2013\Q3-Q4\Sales division\Corp\YR-CORP-Expenses Budget-2013_Q3-Q4update.xls", _
        UpdateLinks:=0
    Sheets("Budget_2011 (EURO)"  .Select
    Range("A1:R227"  .Select
    Selection.Copy
    Windows("Budget 2013.xls"  .Activate
    Sheets("CORP"  .Select
    Cells.Select
    Range("B1"  .Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Windows("YR-CORP-Expenses Budget-2013_Q3-Q4update.xls"  .Activate
              Windows("YR-CORP-Expenses Budget-2013_Q3-Q4update.xls"  .Close

Помогите, пожалуйста!!! :)

vikttur

Пользователь

Сообщений: 47199 Регистрация: 15.09.2012

21.07.2014 20:08:20

shake22, полистайте свое сообщение. Читать удобно-приятно? Смайлики всякие-лишние... То-то же...
А ведь кнопочки на панели не для красоты.
Например, эта -

Правила тоже писаны не просто так. Желательно почитать. На будущее.

Максим Зеленский

Пользователь

Сообщений: 4663 Регистрация: 11.06.2014

Microsoft MVP 2018-2022

21.07.2014 20:17:24

это как-то не три нужных столбца из 10:

Код
Range("A1:R227" ;)

F1 творит чудеса

RAN Пользователь Сообщений: 7207 Регистрация: 21.12.2012	#4 22.07.2014 00:02:42 Прозевал эту тему Особенно интересно совпадение времени первого ответа и размещения кросса на SQL Всего 3 форума за 4 минуты. Скорострел!

Smiley Пользователь Сообщений: 530 Регистрация: 16.05.2013	#5 22.07.2014 10:06:41 shake22, Вы бы хотя бы написали, что тема на 3 формах уже... на sql Вам ответил. Учусь программировать :)

shake22

Пользователь

Сообщений: 24 Регистрация: 21.07.2014

30.07.2014 15:07:37

Кому интересно, сам макрос:

Код

Sub Sbor()
Dim a As Workbook, b As Workbook, p As Long, q As Long
Set a = ThisWorkbook
p = a.Sheets("1".Cells(Rows.Count, "B".End(xlUp).Row
a.Sheets("1".Range("B5:B" & CStr(p) & "".ClearContents
p = a.Sheets("1".Cells(Rows.Count, "E".End(xlUp).Row
a.Sheets("1".Range("E5:E" & CStr(p) & "".ClearContents
p = a.Sheets("1".Cells(Rows.Count, "F".End(xlUp).Row
a.Sheets("1".Range("F5:F" & CStr(p) & "".ClearContents
Set b = Workbooks.Open(Filename:="D:\222.xls", UpdateLinks:=0)
q = b.Sheets("1".Cells(Rows.Count, "A".End(xlUp).Row
b.Sheets("1".Range("A5:A" & CStr(q) & "".Copy
a.Sheets("1".Range("B5".PasteSpecial Paste:=xlPasteValues
q = b.Sheets("1".Cells(Rows.Count, "D".End(xlUp).Row
b.Sheets("1".Range("D5" & CStr(q) & "".Copy
a.Sheets("1".Range("E5".PasteSpecial Paste:=xlPasteValues
q = b.Sheets("1".Cells(Rows.Count, "E".End(xlUp).Row
b.Sheets("1".Range("E5:E" & CStr(q) & "".Copy
a.Sheets("1".Range("F5".PasteSpecial Paste:=xlPasteValues
b.Close savechanges:=False
End Sub

Mark D

Пользователь

Сообщений: 16 Регистрация: 21.05.2023

17.10.2023 20:03:22

Добрый день, помогите пожалуйста написать макрос (см. файл):

В желтые ячейки должны подтягиваться данные по продажам из стороннего файла на рабочем столе "Продажи.xlsx" (в столбце А - Код товара, в столбце В - кол-во продаж) с помощью формулы ВПР, где переменная - Код товара (в столбце А).

Прикрепленные файлы

ВПР МАКРОС.xlsx (9.2 КБ)

МатросНаЗебре

Пользователь

Сообщений: 6538 Регистрация: 05.02.2014

18.10.2023 13:25:20

Код
Range("G2:G4").FormulaR1C1 = "=VLOOKUP(RC1,'" & CreateObject("WScript.Shell").specialfolders("Desktop") & "\[Продажи.xlsx]Лист1'!C1:C2,2,0)"

Цитата
написал: с помощью формулы

Если нужно оставить только значения, то

Код

    With Range("G2:G4")
        .FormulaR1C1 = "=VLOOKUP(RC1,'" & CreateObject("WScript.Shell").specialfolders("Desktop") & "\[Продажи.xlsx]Лист1'!C1:C2,2,0)"
        Dim arr As Variant
        arr = .Value
        .Value = arr
    End With

Mark D Пользователь Сообщений: 16 Регистрация: 21.05.2023	#9 18.10.2023 19:59:05 МатросНаЗебре, Большое спасибо!