Страницы: 1
RSS
Перенос значений ячеек из одной книги в другую
 
Добрый день.
[Всех с днём космонавтики!]

Подскажите, пожалуйста, vba-код.
Нужно перенести значения из Книга№1 из диапазона ячеек A1:A5 и D3:D4 на Лист1 в Книга№2 в диапазон ячеек B4:B8 и F1:F2 на Лист1.
 
Код
Sub CopyValues()
    Dim arr As Variant
    arr = Workbooks("Книга1").Sheets("Лист1").Range("A1:A5")
    Workbooks("Книга2").Sheets("Лист1").Range("B4:B8") = arr
 
    arr = Workbooks("Книга1").Sheets("Лист1").Range("D3:D4")
    Workbooks("Книга2").Sheets("Лист1").Range("F1:F2") = arr
End Sub

С днём космонавтики! )
Изменено: МатросНаЗебре - 12.04.2021 13:42:43
 
Спасибо!
Но почему-то не получается :(
Ничего не выводит..

Код
Sub myTest()

    Dim Kniga As String

    Dim itk, iok As String
    Dim arr As Variant


    Kniga = "D:\test1.xlsx"

    itk = ThisWorkbook.Name 'имя текущей книги

    iok = Dir(Kniga)    'имя открываемой книги


    GetObject (Kniga)

    arr = Workbooks(itk).Sheets("Лист1").Range("A1:A5")
    Workbooks(iok).Sheets("Лист1").Range("B4:B8") = arr

    Workbooks(iok).Close (False)
    

End Sub
Изменено: Alexander - 12.04.2021 15:37:53
 
Код
Sub myTest()
    Dim itk, iok As String
    Dim arr As Variant
 
    Const Kniga = "D:\test1.xlsx"
 
    Dim wb As Workbook
    Set wb = Workbooks.Open(Kniga)
 
    arr = ThisWorkbook.Sheets("Лист1").Range("A1:A5")
    wb.Sheets("Лист1").Range("B4:B8") = arr
 
    wb.Close True
 End Sub
 
не работает :(

открывает файл (test1.xlsx), возможно даже копирует данные, но в текущий файл почему-то ничего не попадает
Изменено: Alexander - 12.04.2021 18:22:39
 
Alexander, поменяйте местами:
Код
arr=wb. Sheets...
ThisWorkbook.Sheets.... =arr
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Нет..не работает(

Ошибки никакой не выдаёт, просто данные не вставляются и всё.

По сути простая задача, но не выходит.
Не понимаю, с чем это связано..
Изменено: Alexander - 12.04.2021 20:16:03
 
Кроме как повторить сообщение #6  в такой ситуации наши полномочия всё.
Код
Sub myTest()
    Dim itk, iok As String
    Dim arr As Variant
  
    Const Kniga = "D:\test1.xlsx"
  
    Dim wb As Workbook
    Set wb = Workbooks.Open(Kniga)
  
    arr = wb.Sheets("Лист1").Range("A1:A5")
    ThisWorkbook.Sheets("Лист1").Range("B4:B8") = arr
  
    wb.Close True
 End Sub
 
Цитата
Alexander написал:
Workbooks(iok).Close (False)
Вы здесь закрываете книгу, в которую вставляете значения БЕЗ СОХРАНЕНИЯ. На какой результат рассчитываете?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
и так тоже не получается
Код
Workbooks(itk).Worksheets("Лист1").Range("E3:E4") = _
Workbooks(iok).Worksheets("Лист1").Range("C8:C9").Value
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Вы здесь закрываете книгу, в которую вставляете значения БЕЗ СОХРАНЕНИЯ. На какой результат рассчитываете?
Сохраниться данные должны в itk
Из otk лишь берутся данные
Изменено: Alexander - 13.04.2021 09:41:24
 
Цитата
Alexander написал:
Из otk лишь берутся данные
судя по коду - все наоборот. Проследите логику своего кода и убедитесь, что Ваше утверждение ошибочно.
Может еще дело в том, что Вы ошибочно полагаете, что ThisWorkbook - это активная на момент запуска кода книга? Но Thisworkbook - это книга, в которой записан кода. Попробуйте так:
Код
Sub myTest()
    Dim wbTo As Workbook, wbFrom As Workbook
    Dim Kniga As String
    Kniga = "D:\test1.xlsx"
    Set wbTo = ActiveWorkbook 'текущая книга
    Set wbFrom = Application.Workbooks.Open(Kniga, False, True)
    wbTo.Sheets("Лист1").Range("A1:A5").Value = wbFrom.Sheets("Лист1").Range("B4:B8").Value
    wbFrom(iok).Close False
End Sub
Изменено: Дмитрий(The_Prist) Щербаков - 13.04.2021 09:55:39
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Если кому интересто, то получилось реализовать вот так:
Код
Sub myTest3()

Dim a, b, t, c As String
Dim itk, iok As String

a = "C:\путь\" 'определяет изначальный путь нужного файла
t = Environ$("TEMP") 'определяет путь в папку TEMP (TEMP - для того, чтобы макрос работал на любом компе)
b = t & Dir(a) 'определяет путь скопированного файла

CreateObject("Scripting.FileSystemObject").GetFile(a).Copy b 'скопировал файл (чтобы избежать ошибки, когда этот файл у тебя вдруг уже открыт)

c = t & "\abc123" & Dir(a) 'определяем новое название скопированному файлу
Name b As c 'переименовываем скопированный файл

itk = ThisWorkbook.Name 'определяем имя текущей книги
iok = Dir(c) 'определяем имя открываемой книги (скопированной и переименованной)

GetObject (c) 'открываем скопированную и переименованную книгу

Workbooks(itk).Worksheets("Лист1").Range("A1:B5") = _
Workbooks(iok).Worksheets("Лист1").Range("A1:B5").Value 'копируем необходимые данные

Workbooks(iok).Close (False)    'закрываем книгу

Kill c  'удаляем книгу

End Sub

Хотя можно было многими другими способами...
Изменено: Alexander - 16.06.2021 11:00:37
Страницы: 1
Наверх