Страницы: 1
RSS
создание книги в папке и копирование туда данных из имеющихся файлов
 
Добрый день, коллеги. Помогите доработать макрос. (взял здесь же на форуме) Макрос открывает файлы в указанной папке делает по циклу что то и закрывает эти файлы.  Нужно чтобы макрос создал в этой папке файл и туда скинул инфу из ячейки а1.
Код
Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        sNextFiles = Dir
.
        действия с файлом
          
        ActiveWorkbook.Sheets(1).Range("A1").Value = "пурурум"
          
          
        ActiveWorkbook.Close True
        sFiles = sNextFiles
    Loop
    Application.ScreenUpdating = True
End Sub
 
Какое-то корявое копирование кода...Непонятно назначение переменной sNextFiles. Оригинал данного кода здесь: Просмотреть все файлы в папке
И примерно так будет выглядеть нужное Вам:
Код
Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    Dim wbRes As Workbook, lLastR As Long
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    Set wbRes = Workbooks.Add
    lLastR = 1
    
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом
        'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
        wbRes.Sheets(1).Cells(lLastR, 1) = ActiveWorkbook.Sheets(1).Range("A1").Value
        lLastR = lLastR + 1
        'Закрываем книгу без сохранения изменений
        ActiveWorkbook.Close 0
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub
Код запишет значение ячейки А1 каждого файла в папке в столбец А нового файла. Сохранить файл можно после работы кода куда угодно. Если надо автоматом - запишите макрорекордером код сохранения и все.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
спасибо большое. сейчас буду пробовать. файл надо сохранить автоматом в той же папке в которой лежат файлы для обработки.
 
Цитата
alexthegreat написал: файл надо сохранить автоматом в той же папке
Так сохраняйте. Макрорекордер это дело записывает отлично. Пока уже учиться хотя бы его применять и делать небольшие правки в коде.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
спасибо за помощь. Если можно, еще вопрос, что то не получается... в макросе прописали ячейку сохранить в ячейку (а1).
Подскажите для того чтобы столбец из одного файла сохранить в столбец другого файла.
пытаюсь выделить и скопировать, но получаю ошибку на селекте.
 
Для того чтобы получить значение ячейки её совершенно не обязательно выделять... ;)
п.с. При выделении ячейки, лист на котором происходит выделение должен быть активным, отсюда и ошибки...
 
пытаюсь активировать лист, но выходит ошибка. Наверное потому что активирую из другой книги. Думаю можно и без активации листа скопировать столбцы. Но не выходит.....
Страницы: 1
Наверх