Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для копирования столбцов из одной книги в другую
 
#1
12.12.2016 12:23:51
Добрый день!
Помогите пожалуйста доделать макрос. Общая идея такая: из книги "копирование столбцов.xlsx" запускается макрос, который вызывает окно выбора файла. Это может быть любой файл, и фиксированного имени у него нет. Поэтому я и открываю его вручную. Здесь в примере это "Книга2копирование.xlsx". Потом я из первой книги копирую во вторую книгу(открытую диалоговым окном) нужные мне столбцы. Копирую только как значения. Проблема в том, что я писала макрос макрорекодером и не могу правильно сделать передачу имени открытого из диалогового окна файла. У меня это строка

'активируем книгу куда копируем
Windows("Книга2копирование.xlsx").Activate  
Она получается завязанной именно на имя моего примера, а должна получать имя файла, открытого из диалогового окна. Помогите пожалуйста разобраться!
Код
Sub Макрос1()
' Макрос1 Макрос
' открываем книгу куда будем копировать
        fileopenname = Application.GetOpenFilename(fileFilter:="Книги Excel (*.xls*), *.xls*", Title:="Введите путь к файлу данных")
        Workbooks.OpenText Filename:=fileopenname, Origin:=866 _
        , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
        Application.ScreenUpdating = False
      ' активируем книгу откуда копируем
    Windows("копирование столбцов.xlsx").Activate
    'выделяем нужный столбец
    Columns("A:A").Select
    Selection.Copy
    'активируем книгу куда копируем
       Windows("Книга2копирование.xlsx").Activate
        Columns("A:A").Select
    ' вставляем только значения
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     End Sub
 
 
 
#2
12.12.2016 12:31:40
Код
Sub Макрос1()
fileopenname = Application.GetOpenFilename(fileFilter:="Книги Excel (*.xls*), *.xls*", Title:="Введите путь к файлу данных")
Workbooks.OpenText Filename:=fileopenname, Origin:=866 _
        , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
        Application.ScreenUpdating = False
Workbooks("копирование столбцов.xlsx").Worksheets("Имя_листа_ОТКУДА_копируем").Columns("A:A").Copy
Workbooks(fileopenname).Worksheets("Имя_листа_КУДА_копируем").Columns("A:A").PasteSpecial Paste:=xlPasteValues
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
12.12.2016 12:42:36
Спасибо большое за помощь. Только я хочу спросить - если мне заранее неизвестно имя листа куда копируем, тогда как быть? Я могу узнать имя этого листа только открыв тот файл.
 
 
 
#4
12.12.2016 12:53:45
Можно имя заменить номером
Код
Workbooks(fileopenname).Worksheets(1).Columns("A:A").PasteSpecial Paste:=xlPasteValues
Изменено: Sanja - 12.12.2016 12:53:54
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
12.12.2016 13:00:04
Выдает ошибку
Изменено: Louie77 - 12.12.2016 13:07:15
 
 
 
#6
12.12.2016 13:46:02
Workbooks("копирование столбцов.xlsx").Worksheets(1).Columns("A:A").Copy

На этой строке выходит  Run-time error '9':
Subscript out of range.  Что я могу сделать?
 
 
 
#7
12.12.2016 14:03:47
Цитата
Louie77 написал:
На этой строке выходит  Run-time error '9':
Потому что в коде имя книги копирование столбцов.xlsx, а реально он называется копирование столбцов.xlsm
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
12.12.2016 14:11:01
 Поменяла, теперь ругается этими же словами на вторую строчку, куда копируем. Там-то что ему не так? :(
 
 
 
#9
12.12.2016 14:20:54
Я может ошибаюсь, но Application.GetOpenFilename  не возвращает ли нам весь путь к файлу? А нам ведь надо вынуть оттуда только имя с расширением?
 
 
 
#10
12.12.2016 14:26:08
Цитата
Louie77 написал:
не возвращает ли нам весь путь к файлу?
Код
fName = CreateObject("Scripting.FileSystemObject").GetFileName(fileopenname)
Workbooks(fName).Worksheets(1).Columns("A:A").PasteSpecial Paste:=xlPasteValues
Согласие есть продукт при полном непротивлении сторон
 
 
 
#11
12.12.2016 14:30:19
спасибо большое вам за помощь. У меня благодаря вам тоже получилось нечто. Не так красиво, как у вас, но тоже работает:
Код
'активируем книгу куда копируем
    W = fileopenname
    NF = Dir(W)
    Workbooks(NF).Worksheets(1).Columns("A:A").PasteSpecial Paste:=xlPasteValues
       Спасибо еще раз огромное за вашу помощь.
Изменено: Louie77 - 12.12.2016 14:31:49
 
 
 
#12
12.12.2016 14:32:41
Код
Workbooks("копирование столбцов.xlsx").Worksheets(1).Columns("A:A").Copy
'можно заменить на
ThisWorkbook.Worksheets(1).Columns("A:A").Copy
Согласие есть продукт при полном непротивлении сторон
 
 
 
#13
12.12.2016 14:36:33
Это будет совсем хорошо, тогда макрос становится универсальным для меня :D
 
 
 
#14
12.12.2016 14:39:03
Пойду допишу в макрос еще сотню столбцов, это ведь был, так сказать  , пробный. :D
 
 
 
#15
12.12.2016 14:56:23
Цитата
'активируем книгу куда копируем
Так она у вас и так активна ( при открытии книги)
 
 
 
#16
12.12.2016 14:59:09
Я знаю :oops:. Просто я ворона, убрала в комментарии и скопировала все до кучи. Спасибо за  замечание, буду внимательнее.
 
 
 
#17
12.12.2016 15:12:52
Выложу сюда то, что получилось, вдруг кому пригодится
Код
Sub Макрос5()
' макрос копирует из открытой книги, откуда он запущен, столбцы в другую книгу, выбранную пользователем с помощью диалоговой формы

' открываем книгу куда будем копировать
        fileopenname = Application.GetOpenFilename(fileFilter:="Книги Excel (*.xls*), *.xls*", Title:="Введите путь к файлу данных")
        Workbooks.OpenText Filename:=fileopenname, Origin:=866 _
        , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
        Application.ScreenUpdating = False
    'Workbooks("копирование столбцов.xlsm").Worksheets(1).Columns("A:A").Copy
    'можно заменить на
     ThisWorkbook.Worksheets(1).Columns("A:A").Copy
     fName = CreateObject("Scripting.FileSystemObject").GetFileName(fileopenname)
     Workbooks(fName).Worksheets(1).Columns("A:A").PasteSpecial Paste:=xlPasteValues
     Workbooks(fName).Activate
     Application.ScreenUpdating = True
     MsgBox "Копирование завершено"
     
End Sub
Изменено: Louie77 - 12.12.2016 15:17:19
 
 
 
#18
12.12.2016 15:39:53
Цитата
'можно заменить на     ThisWorkbook.Worksheets(1).Columns("A:A").Copy     fName = CreateObject("Scripting.FileSystemObject").GetFileName(fileopenname)     Workbooks(fName).Worksheets(1).Columns("A:A").PasteSpecial Paste:=xlPasteValues     Workbooks(fName).Activate
На мой взгляд
Код
'можно заменить на
     ThisWorkbook.Worksheets(1).Columns("A:A").Copy
     ActiveWorkbook.Worksheets(1).Columns("A:A").PasteSpecial Paste:=xlPasteValues
  
 
 
 
Страницы: 1
Читают тему
Наверх