Страницы: 1
RSS
Макрос. Копирование данных в лист другого файла с изменяющимся названием
 
Помогите, пожалуйста. Не могу справиться с кодом

Название листа зависит от содержимого ячейки: Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Value
Копировать нужно с 2й строки Workbooks("Book1.xlsm").Sheets("Invoices") - в момент копирования макрос находится именно на этом листе
Попробовала так
Код
Sub Copy_Data()

    Dim bk_src As Workbook, bk_res As Workbook, sh_res As Worksheet
    Set bk_src = Workbooks("Book1.xlsm")
    Set bk_res = Workbooks("Book2.xlsm")
    sh_res.Name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Value
    sh_src.UsedRange.Offset(1, 0).Copy sh_res.[A1].End(xlDown)(2)
    
MsgBox ("INCOICES DOWNLIADING - Compleat!")

End Sub

Макрос выдает ошибку именно на :
Код
sh_res.Name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Value
 
Worksheets("Macro") - нет такого листа.
sh_src - это что вообще?
в ячейке у вас всего лишь текст, так что 6 строка изначально не правильная.
 
Спасибо, конечно! Но вот новичок типа меня, нифига не поймет :( точнее я то и не поняла.
Файл Book1 приложила неправильный - Извиняюсь!
 
Код, приведенный в сообщении 1, не совпадает с кодом из файла
 
Да, я уже пыталась его поправить :( однако, ничего не вышло
Код
Sub Copy_Data()

    Dim sh_src As Worksheet, sh_res As Worksheet
    Set sh_src = Workbooks("Book1.xlsm").Worksheets("Invoices")
    Set rg_src = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6")
    Set sh_res = Workbooks("Book2.xlsx").Sheets(rg_src.Value)
    sh_src.UsedRange.Offset(1, 0).Copy sh_res.[A1].End(xlDown)(2)
    
MsgBox ("INCOICES DOWNLIADING - Compleat!")
End Sub
Изменено: Мария - - 11.05.2019 20:30:00
 
Код
Dim Sh_name as String
Sh_name= Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Text
 
"Book2.xlsX" или "Book2.xlsM"
 
Спасибо! Но теперь он ругается на последнюю строку :( мне кажется я никогда до этого не дойду :(

Вот что получилось. Правиль?
Код
Sub Copy_Data()

    Dim sh_src As Worksheet, sh_res As Worksheet
    Set sh_src = Workbooks("Book1.xlsm").Worksheets("Invoices")
    Dim Sh_name As String
    Sh_name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Text
    Set sh_res = Workbooks("Book2.xlsm").Sheets(Sh_name)
    sh_src.UsedRange.Offset(1, 0).Copy sh_res.[A1].End(xlDown)(2)
    
MsgBox ("INCOICES DOWNLIADING - Complete!")

End Sub
Ругается на строку
Код
sh_src.UsedRange.Offset(1, 0).Copy sh_res.[A1].End(xlDown)(2)
 
Цитата
ругается на последнюю строку
При пустом листе sh_res неправильно определяется последняя строка
Код
sh_res.[A1].End(xlDown)(2)
 
Вот я ТУПЕНЬ!!! Конечно же. В примере Book2 нет шапки таблицы!!

СПАСИБО ОГРОМЕННОЕ!
 
Неплохо было бы сделать проверку наличия во второй книге листа Sh_name
 
Kuzmich, А помогите, пожалуйста, подпилить для другого отчета  :oops: . Если скопировать нужно все с 2й строки 1й колонки, а вот вставить с 6й колонки в последнюю строку?
Код
Sub Copy_Data()

    Dim sh_src As Worksheet, sh_res As Worksheet
    Set sh_src = Workbooks("Book1.xlsm").Worksheets("Invoices")
    Dim Sh_name As String
    Sh_name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Text
    Set sh_res = Workbooks("Book2.xlsx").Sheets(Sh_name)
    sh_src.UsedRange.Offset(1, 0).Copy sh_res.[A1].End(xlDown)(2)
    
MsgBox ("INCOICES DOWNLIADING - Complete!")

End Sub
 
Цитата
вставить с 6й колонки в последнюю строку
Последняя строка в столбце F
Код
iLastRow = Cells(Rows.Count, "F").End(xlUp).Row
Вставляйте после копирования в
Код
sh_res.Cells(iLastRow,"F")

 
Kuzmich, Простите, пожалуйста. Я на счет проверки наличия листа. Да, такая проверка нужна, при чем если нет такого листа, то создать его и скопировать на него все данные из Book1.Invoice.
Но что-то у меня не выходит :(
Код
Sub Copy_Data()

    Dim sh_src As Worksheet, sh_res As Worksheet
    Set sh_src = Workbooks("Book1.xlsm").Worksheets("Invoices")
    Dim Sh_name As String
    Sh_name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Text
    Set sh_res = Workbooks("Book2.xlsx").Sheets(Sh_name)
    sh_src.UsedRange.Offset(1, 0).Copy sh_res.[A1].End(xlDown)(2)
    
    For Each sh_res In Worksheets
    If sh.Name = Sh_name Then
    MsgBox "åñòü òàêîé ëèñò"
    Else
    Sheets(Sh_name).Copy Before:=Sheets(1)
    Sheets(1).Name = "Sold-to for report"
    sh_src.Cells.Copy
    sh_res.Paste
End If
Next
MsgBox ("INCOICES DOWNLIADING - Complete!")

End Sub
 
Цитата
на счет проверки наличия листа.
Код
Sub Copy_Data()
Dim sh_src As Worksheet, sh_res As Worksheet
 Set sh_src = Workbooks("Book1.xlsm").Worksheets("Invoices")
Dim Sh_name As String
    Sh_name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Text
     Workbooks("Book2.xlsm").Activate
      If Not SheetExist(Sh_name) Then  'функция проверки наличия листа в файле
        sh_src.Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Sh_name
      End If
   MsgBox ("INCOICES DOWNLIADING - Complete!")
End Sub

     'функция проверки наличия листа в файле, лист есть - true
Function SheetExist(iName As String) As Boolean
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
End Function

 
Цитата
Мария - написал: ругается на последнюю строку
- я тоже буду ругаться на
Цитата
Мария - написал: "INCOICES DOWNLIADING"
Может лучше это написать на понятном языке? :)
 
Kuzmich,и все таки я что-то делаю не так. Если лист с таким именем существует, он не делает копирование данных
 
Kuzmich, Hugo, плиииз помогите! Оно не работает :(
 
Цитата
Если лист с таким именем существует, он не делает копирование данных
Макрос в сообщении 15 делает проверку наличия листа и, если листа нет, то добавляет его в книгу. А копирование данных добавьте в код
после проверки наличия листа
Страницы: 1
Наверх