Переименовать лист во всех файлах в папке

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Переименовать лист во всех файлах в папке (Макросы Sub)

Fairuza

Дата: Пятница, 13.09.2013, 10:54 | Сообщение № 1

Группа: Проверенные

Ранг: Участник

Сообщений: 57

Репутация: 13 ±

Замечаний: 0% ±

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

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

Ответить

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

Ответить

Fairuza

Дата: Пятница, 13.09.2013, 11:42 | Сообщение № 3

Группа: Проверенные

Ранг: Участник

Сообщений: 57

Репутация: 13 ±

Замечаний: 0% ±

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

Ответить

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

Ответить

Переименовать лист во всех файлах в папке (Макросы Sub)

Страница 1 из 1
1