Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Переименовать лист во всех файлах в папке - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Переименовать лист во всех файлах в папке
Fairuza Дата: Пятница, 13.09.2013, 10:54 | Сообщение № 1
Группа: Проверенные
Ранг: Участник
Сообщений: 57
Репутация: 13 ±
Замечаний: 0% ±

Доброго всем дня!
Суть проблемы. Есть папка, в ней 100 файлов с разными названиями, в файлах по одному листу, названия листов в каждом файле различное. Надо, чтобы названия листов в каждом файле было одинаковое, конкретно tmpQuery1.

Помогите, пожалуйста. Просто таких папок довольно большое количество.
Спасибо.
 
Ответить
СообщениеДоброго всем дня!
Суть проблемы. Есть папка, в ней 100 файлов с разными названиями, в файлах по одному листу, названия листов в каждом файле различное. Надо, чтобы названия листов в каждом файле было одинаковое, конкретно tmpQuery1.

Помогите, пожалуйста. Просто таких папок довольно большое количество.
Спасибо.

Автор - Fairuza
Дата добавления - 13.09.2013 в 10:54
KuklP Дата: Пятница, 13.09.2013, 11:32 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
[vba]
Код
Sub MyFiles()
      Dim fso As Object, file As Object, fpath$
      On Error Resume Next
      Application.DisplayAlerts = 0
      With Application.FileDialog(msoFileDialogFolderPicker)
          .Show: fpath = .SelectedItems(1)
      End With
      Set fso = CreateObject("scripting.filesystemobject").getfolder(fpath)
      For Each file In fso.Files
          With Workbooks.Open(file.Path)
              .Sheets(1).Name = "tmpQuery1": .Close -1
          End With
      Next
      Application.DisplayAlerts = -1
     set file=nothing:set fso=nothing
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Пятница, 13.09.2013, 11:35
 
Ответить
Сообщение[vba]
Код
Sub MyFiles()
      Dim fso As Object, file As Object, fpath$
      On Error Resume Next
      Application.DisplayAlerts = 0
      With Application.FileDialog(msoFileDialogFolderPicker)
          .Show: fpath = .SelectedItems(1)
      End With
      Set fso = CreateObject("scripting.filesystemobject").getfolder(fpath)
      For Each file In fso.Files
          With Workbooks.Open(file.Path)
              .Sheets(1).Name = "tmpQuery1": .Close -1
          End With
      Next
      Application.DisplayAlerts = -1
     set file=nothing:set fso=nothing
End Sub
[/vba]

Автор - KuklP
Дата добавления - 13.09.2013 в 11:32
Fairuza Дата: Пятница, 13.09.2013, 11:42 | Сообщение № 3
Группа: Проверенные
Ранг: Участник
Сообщений: 57
Репутация: 13 ±
Замечаний: 0% ±

KuklP, Спасибо большое за оперативность. Сейчас опробую.
 
Ответить
СообщениеKuklP, Спасибо большое за оперативность. Сейчас опробую.

Автор - Fairuza
Дата добавления - 13.09.2013 в 11:42
Serge_007 Дата: Пятница, 13.09.2013, 19:31 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Вариант:
[vba]
Код
Sub Change_Sheets_Name()
           Dim sPath$, sXL$
           sPath = "C:\путь_до_файлов"
           sPath = sPath & IIf(Right(sPath, 1) = Application.PathSeparator, "", Application.PathSeparator)
           Application.ScreenUpdating = 0
           Application.DisplayAlerts = 0
           sXL = Dir(sPath & "*.xls*")
               Do While sXL <> ""
                   Workbooks.Open sPath & sXL
                   ActiveWorkbook.ActiveSheet.Name = "tmpQuery1"
                   ActiveWorkbook.Close -1
                   sXL = Dir
               Loop
           Application.DisplayAlerts = -1
           Application.ScreenUpdating = -1
End Sub
[/vba]
PS Можно приделать FileDialog, если надо


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеВариант:
[vba]
Код
Sub Change_Sheets_Name()
           Dim sPath$, sXL$
           sPath = "C:\путь_до_файлов"
           sPath = sPath & IIf(Right(sPath, 1) = Application.PathSeparator, "", Application.PathSeparator)
           Application.ScreenUpdating = 0
           Application.DisplayAlerts = 0
           sXL = Dir(sPath & "*.xls*")
               Do While sXL <> ""
                   Workbooks.Open sPath & sXL
                   ActiveWorkbook.ActiveSheet.Name = "tmpQuery1"
                   ActiveWorkbook.Close -1
                   sXL = Dir
               Loop
           Application.DisplayAlerts = -1
           Application.ScreenUpdating = -1
End Sub
[/vba]
PS Можно приделать FileDialog, если надо

Автор - Serge_007
Дата добавления - 13.09.2013 в 19:31
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!