Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Перенос определенных данных из одной книги в другую
 
#1
18.03.2013 15:59:32
Здравствуйте уважаемые форумчане! прошу помощи, подскажите! в одной и той же папке есть два файла: 1) book1.xls и 2) copy_book1.xls
необходимо со второй книги(copy_book1.xls) с определенного листа, определенной ячейки, перенести данные(значение ячейки) в книгу book1.xls в определенный лист(лист с тем же названием что и в копии книги) в ячейку отличную адресом
Пытался сделать что то вроде такого:
Workbooks(ws.Name).Sheets("Кв_1").Range("F22").Value = Workbooks("copy_" & ws.Name).Sheets("Кв_1").Range("F20").Value

не выходит...((
Помогите пожалуйста!
 
 
 
#2
18.03.2013 16:10:04
А что пишет? Ошибка? Или просто ничего нет?
There is no knowledge that is not power
 
 
 
#3
18.03.2013 16:27:08
Runtime error '424'
Object required
 
 
 
#4
18.03.2013 17:41:34
если прописывать в самих ячейках формулу, то появляются "связи" с другой книгой, а этого не хотелось бы, потому как у "связей" есть свойство теряться...необходимо скопировать данные через VB...можно конечно пойти по "длинному пути", т.е. макросом задать команду открыть другую книгу, выделить ячейку, скопировать в буфер, затем сделать активным окно с нужной книгой(куда будет вставляться все), выделить нужную ячейку, вставить из буфера данные...но это громоздко как то получается...
 
 
 
#5
19.03.2013 09:15:36
может можно в "фоновом" режиме такое проделать? т.е. что то типа такого Workbooks(ws.Name).visible=false ?
правда наверно тормоза будут...
 
 
 
#6
19.03.2013 09:56:52
Пробовал сделать такое:

Private Sub CommandButton8_Click()
  Dim Sht As Worksheet
  Dim Wb As Workbook
  Dim iTempFileName As String
  Dim i As Long
  Dim Fran As Range
 
  With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .Calculation = xlManual
  Set Wb = ThisWorkbook
  Set Sht = Wb.Sheets("Кв_1")
  iPath = Wb.Path & "\"
  iTempFileName = "Copy_" & ThisWorkbook.Name   'Книга из которой берутся данные должна быть в том же каталоге
  Set tWb = Workbooks.Open(Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
   tWb.Sheets("Кв_4").Range("D20").Copy Sht.Range("F22")
   tWb.Close SaveChanges:=False      ' закрыть книгу без сохранения изменений
       .Calculation = xlAutomatic
       .DisplayAlerts = True
       .ScreenUpdating = True
   End With
End Sub

пишет ошибку: Device I/O error  ...хотя мышка превращается в песочные часы(типа что то происходит) не надолго, а результат=так и не переносит данные....

Помогите плиз!!!!
 
 
 
#7
25.03.2013 11:01:08
Народ! ПОМОГИТЕ!!!! нашел некое решение:
Dim sFile1 As String, sFile2 As String, i As Long, j As Long, sh As Worksheet, sh1 As Worksheet
Dim wb As Workbook, wb1 As Workbook, lr As Long, lc As Long, wbTmp As Workbook, sName As String
sFile1 = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбирете файл (с какого переносить)")
If sFile1 = "False" Then Exit Sub
sFile2 = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выберете файл(куда переносить)")
If sFile2 = "False" Then Exit Sub
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
Set wb = GetObject(sFile1)
Set wb1 = GetObject(sFile2)
For Each sh In wb.Sheets
   For Each sh1 In wb1.Sheets
       If sh.Name = sh1.Name Then
           lr = wb.Sheets(sh.Name).UsedRange.Rows.Count
           lc = wb.Sheets(sh.Name).UsedRange.Columns.Count
           For i = 1 To lr
               For j = 1 To lc
               If wb.Sheets(sh.Name).Cells(i, j).Locked = False Then wb1.Sheets(sh.Name).Cells(i, j).Value = wb1.Sheets(sh.Name).Cells(i, j).Value
               Next
           Next
       End If
   Next
Next
sName = wb.FullName
wb.Close True: wb1.Close False
Kill sName
Set wb1 = Nothing: Set wb = Nothing
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

НО! пишет ошибку в строке: If wb.Sheets(sh.Name).Cells(i, j).Locked = False Then wb1.Sheets(sh.Name).Cells(i, j).Value = wb1.Sheets(sh.Name).Cells(i, j).Value

Runtime error '1004'
Application-defuned or object-defined error

НУ ОЧЕНЬ ПРОШУ ПОМОЧЬ!!!!!
 
 
 
#8
25.03.2013 11:55:15
В варианте #6 определены не все переменные
и убедитесь что лист "Кв_1" есть в книге Book1.xls
а лист "Кв_4" есть в книге Copy_Book1.xls


Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Option Explicit
 
Private Sub Perenos()
 Dim Sht As Worksheet
 Dim Wb As Workbook
 Dim tWb As Workbook
 Dim iTempFileName As String
 Dim i As Long
 Dim Fran As Range
 Dim iPath As String
  
 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False
 .Calculation = xlManual
 Set Wb = ThisWorkbook
 Set Sht = Wb.Sheets("Кв_1")
 iPath = Wb.Path & "\"
 iTempFileName = "Copy_" & ThisWorkbook.Name 'Книга из которой берутся данные должна быть в том же каталоге
 Set tWb = Workbooks.Open(Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
 tWb.Sheets("Кв_4").Range("D20").Copy Sht.Range("F22")
 tWb.Close SaveChanges:=False ' закрыть книгу без сохранения изменений
 .Calculation = xlAutomatic
 .DisplayAlerts = True
 .ScreenUpdating = True
 End With
End Sub
 
 
 
#9
25.03.2013 12:56:03
наверно это работает, но у меня данные ячейки защищены от редактирования...можно ли внести изменения в защищенные ячейки, чтоб "программно" менялись значения и пользователь не мог их редактировать?
 
 
 
#10
25.03.2013 13:00:25
в начале кода программно снимаем защиту листа, а в конце кода снова ставим защиту на лист.

Смотрите справку по Protect
 
 
 
#11
25.03.2013 13:03:53
Цитата
Mike пишет:
можно ли внести изменения в защищенные ячейки, чтоб "программно" менялись значения и пользователь не мог их редактировать?
Можно
 
 
 
#12
25.03.2013 16:02:14
Спасибо! все получилось!
 
 
 
#13
25.03.2013 17:28:24
Вообще после прочтения первого поста как лучшее решение видится такое - макросом прописываем в ячейку формулу, затем меняем на значение:
Код
?
1
2
    ActiveCell.Formula = "='C:\Temp\[copy_book1.xls]Лист1'!$A$1"
    ActiveCell.Value = ActiveCell.Value

и в общем всё.
Хотя конечно ПЕРЕНЕСТИ так не получится, но скопировать вполне. Быстро и без лишних действий.
Изменено: Hugo - 25.03.2013 17:30:04
 
 
 
#14
25.03.2013 18:00:58
Уважаемы Hugo! дело в том, что таких книг порядка 30, и вторая часть в имени файла у всех разная, а именно book1.xls (в данном посте это название как пример), и в общем, в 30 книгах в ячейках прописывать "свое" имя муторно. Возьму Ваш вариант на заметку в будущем :-) спасибо!
 
 
 
Страницы: 1
Читают тему
Loading...