Как можно перенести данные из одной ячейки в другую между разными книгами, только что бы в конечной отображалось число а не ссылка на ячейку в другой книги? З.ы: в первой книге числа для переноса формируются простыми формулами.
Sub Макрос()
Range("C2").Select
Selection.Copy
Windows("Книга1").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Переносим значение из ячейки C2 в ячейку A2 другой книги. Запишите макрокодером то что вам нужно и посмотрите, как происходит перенос.
DopplerEffect, А если с определенного листа одной книги на определенны лист другой книги. И еще с одной книги с определенных ячеек на другую в другие ячейки. К примеру: Книга1, лист 1, ячейка R35C14 Скопировать значение в Книга 2, лист2, ячейка R3C17. И так несколько ячеек. Вот так будет работать:
Код
Sub ПРАЙС_Кнопка_Щелчок()
Workbooks("Прайс1.xlsx")
Sheets("лист1").Select
Range("R35:C14").Select
Range("R38:C13").Select
Selection.Copy
Workbooks("Прайс2.xlsx")
Sheets("лист2").Select
Range("R3:C17").Select
Range("R10:C17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub ПРАЙС_Кнопка_Щелчок()
With Workbooks("Прайс1.xlsx").Sheets("лист1")
Workbooks("Прайс2.xlsx").Sheets("лист2").Range("R3:C17,R10:C17") = _
.Range("R35:C14,R38:C13").Value
End With
End Sub
ну по таким прикреплениям меня не пускают..) книги нужны чтоб понять, по какому принципу строится соответствие
Цитата
Maria12345 написал: одной книги с определенных ячеек на другую в другие ячейки
если адреса ячеек разные в двух книгах, макросу надо как-то объяснить, в какие именно ячейки вставлять.Хотя может у Вас постоянно одинаковые ячейки копируются и вставляются всегда в одно и то же место.
тут уже не только копирование, а еще открытие книги, либо использование GetObgect(), но думаю это не для этой темы Смею предположить, что у Maria12345, будут обе книги открыты
"Все гениальное просто, а все простое гениально!!!"
yozhik, Вот ссылка на книги в архивеКниги excel Нужно не диапазон а конкретную ячейку и так же в конкретную вставить значение. А нужно что бы две книги были открыты, а если одна из которой копируются значения открыта?
Sub ПРАЙС_Кнопка_Щелчок()
Dim p1 As Workbook, p2 As Workbook
Set p1 = Workbooks("Прайс1.xlsx")
Set p2 = GetObject("C:\Users\A.Maria\Desktop\test\Прайс2.xlsx")
p2.Worksheets("лист2").Range("Q3").Value = p1.Worksheets("лист1").Range("N35").Value
p2.Worksheets("лист2").Range("Q10").Value = p1.Worksheets("лист1").Range("M38").Value
p2.Close 1
End Sub
Maria12345, особо не вникал - гляньте. Долго мучился с разными вариантами активации книги и копированием всех ячеек листа… Пример кода с активацией книги, проверкой нужных листов и переносом полным копированием и массивом (только значения):
КОД
Код
Option Explicit
Sub ВосстановитьИзАрхива()
Dim wb1 As Workbook, wb2 As Workbook, sh As Worksheet, arr()
Dim txt$, billName$, logName$
Dim flag As Boolean, flag2 As Boolean, i&, lr&
If MsgBox("Вы собираетесь восстановить детализацию из архивного файла для её изменения?" & vbLf & vbLf & "Продолжить?", vbOKCancel + vbQuestion + vbDefaultButton2) = vbCancel Then GoTo ex
txt = GetFilePath("Выберите архивный файл-отчёт по необходимой ведомости (*.xlsx)", ThisWorkbook.Path, "*.xlsx")
If txt = "" Then Exit Sub
Application.ScreenUpdating = 1: On Error GoTo er
On Error GoTo 0
billName = "ведомость": logName = "хранилище (выгрузка)"
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(txt)
For Each sh In wb2.Worksheets
If sh.Name = billName Then flag = 1
If sh.Name = logName Then flag2 = 1
Next sh
If Not flag Then MsgBox "В выбранном файле отсутствует лист «" & billName, vbCritical, "ОШИБКА ФАЙЛА": wb2.Close False: GoTo ex
If Not flag2 Then MsgBox "В выбранном файле отсутствует лист «" & logName, vbCritical, "ОШИБКА ФАЙЛА": wb2.Close False: GoTo ex
lr = wb2.Worksheets(logName).Cells(Rows.Count, 1).End(xlUp).Row
arr = wb2.Worksheets(logName).Cells(2, 1).Resize(lr - 1, 14).Value
wb2.Worksheets(billName).Cells.Copy
wb1.Worksheets(billName).Activate
wb1.Worksheets(billName).Cells.Select
wb1.Worksheets(billName).Paste
Application.CutCopyMode = 0: wb2.Close False
wb1.Worksheets("накопительная").Range("C2").Resize(lr - 1, 14).Value = arr
GoTo fin
er: MsgBox "Сообщите разработчику…", vbCritical, "НЕПРЕДВИДЕННАЯ ОШИБКА"
ex: MsgBox "Отмена выполнения…", vbInformation, "ВЫХОД"
fin: Application.ScreenUpdating = 1: Application.DisplayAlerts = 1: Application.CutCopyMode = 0
End Sub
'===============================================
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
Optional ByVal InitialPath As String = "c:\", _
Optional ByVal FilterDescription As String = "Книги Excel", _
Optional ByVal FilterExtention As String = "*.xls*") As String
' функция выводит диалоговое окно выбора файла с заголовком Title,
' начиная обзор диска с папки InitialPath
' возвращает полный путь к выбранному файлу, или пустую строку в случае отказа от выбора
' для фильтра можно указать описание и расширение выбираемых файлов
On Error Resume Next
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
.Filters.Clear: .Filters.Add FilterDescription, FilterExtention
If .Show <> -1 Then Exit Function
GetFilePath = .SelectedItems(1): PS = Application.PathSeparator
End With
End Function
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
yozhik, Ура, последний ваш скрипт сработал, Спасибо) Подскажите а как будет правильно выглядеть шаблон скрипта если туда добавить еще копирование значений с еще одного листа этой же книги на другой лист. И как добавлять еще ячейки для копирования?
Если копируемые ячейки логически связать никак нельзя по каким-нибудь признакам, чтоб зациклить копирование, размножайте строчку 5 или 6, вписывайте нужные названия листов и адреса ячеек. В формате А1. У Вас формат на скрине R1C1
Option Explicit
Sub ПРАЙС_Кнопка_Щелчок()
Dim p1 As Worksheet
Set p1 = Workbooks("Прайс1.xlsx").Worksheets("лист1")
With GetObject("C:\Users\A.Maria\Desktop\test\Прайс2.xlsx").Worksheets("лист2")
.[Q3].Value = p1.[N35].Value
.[Q10].Value = p1.[M38].Value
.Parent.Close 1
End With
End Sub
Nordheim, а в .Parent.Close True, часом, точка не пропущена?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Nordheim, Спасибо большое за скоректированный код) Буду очень рада если подскажите еще как добавлять туда еще книги и листы для копирования. Вот так не работате(
Код
Option Explicit
Sub ПРАЙС_Кнопка_Щелчок()
Dim p1 As Worksheet, p2 As Worksheet
Set p1 = Workbooks("Прайс1.xlsx").Worksheets("лист1")
With GetObject("C:\Users\A.Maria\Desktop\test\Прайс2.xlsx").Worksheets("лист2")
.[Q3].Value = p1.[N35].Value
.[Q10].Value = p1.[M38].Value
.Parent.Close 1
End With
Set p2 = Workbooks("Прайс2.xlsx").Worksheets("лист2")
With GetObject("C:\Users\A.Maria\Desktop\test\Прайс2.xlsx").Worksheets("лист3")
.[Q5].Value = p2.[N36].Value
.[Q11].Value = p2.[M40].Value
.Parent.Close 1
End With
End Sub
Nordheim написал: Что и куда в итоге нужно переносить?
Нужно как и в первом случае скопировать значение определенных ячеек с определенной книги и листа на другую. Пример: С Книги "Прайс1", "лист1", "ячейка B1" в Книгу "Прайс2", "лист2", "ячейка Q3" И С Книги "Прайс3" лист "лист5" в Книгу "Прайс2", "лист2", "ячейка Q15"
Для одногой книги и листа работает а как добавить еще книги с которых надо копировать значения...не получается ничего(
Вот так макрос сработал: Но в конечном файле куда должны перенестись значения ничего не показывается, просто пусто вот Скрин
Код
Option Explicit
Sub Цены()
Dim p1 As Worksheet, p2 As Worksheet
Set p1 = Workbooks("price.xlsm").Worksheets("Профнастил.")
With GetObject("C:\Users\R.Danilyuk\Desktop\TEST\products1.xlsx").Worksheets("Products")
.[Q48].Value = p1.[P25].Value
.Parent.Close 1
End With
Set p2 = Workbooks("price22.xlsx").Worksheets("Металлочерепица RAUNI")
With GetObject("C:\Users\R.Danilyuk\Desktop\TEST\products1.xlsx").Worksheets("Products")
.[Q2].Value = p2.[N19].Value
.Parent.Close 1
End With
End Sub