[已解决]批量将整个文件夹中的excel表格的sheet1重命名

xiaolin1113

1、一个文件夹内有很多个excel表格，每一个表格中有一个工作簿名（sheet1），需要批量将整个文件夹中的excel表格的sheet1重命名为每个excel表格的A2内容。请问用vba如何操作？2、一个文件夹内有很多个excel表格，每一个表格中有一个工作簿名（汉字名），需要批量将整个文件夹中的excel表格的（汉字名）重名称为sheet1，如果有多个，则这个excel表格的第二个sheet2为。请问用vba如何操作？
3、请问两个vba执行，怎么合成一个执行？

最佳答案

月排行榜 / 总排行榜

7171

2016-12-19 19:00

Sub t()
'把代码放到新的Excel文件中运行

  strPath = ThisWorkbook.Path & Application.PathSeparator
  strFilename = Dir(strPath & "*.xls*")
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  On Error Resume Next
  Do While Len(strFilename)
    If strFilename <> ThisWorkbook.Name Then
      With GetObject(strPath & strFilename)     
        .Windows(1).Visible = True
        .Worksheets(1).Name = .Worksheets(1).Range("A2")  
        .SaveAs Filename:=strPath & .Worksheets(1).Range("A2")  
        .Close    '
        Kill strPath & strFilename      
      End With
    End If
    strFilename = Dir
  Loop

End Sub
已修改，试试

跳转到最佳答案楼层

7171

Sub t()
'把代码放到新的Excel文件中运行

  strPath = ThisWorkbook.Path & Application.PathSeparator
  strFilename = Dir(strPath & "*.xls*")
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  On Error Resume Next
  Do While Len(strFilename)
    If strFilename <> ThisWorkbook.Name Then
      With GetObject(strPath & strFilename)     
        .Windows(1).Visible = True
        .Worksheets(1).Name = .Worksheets(1).Range("A2")  
        .SaveAs Filename:=strPath & .Worksheets(1).Range("A2")  
        .Close    '
        Kill strPath & strFilename      
      End With
    End If
    strFilename = Dir
  Loop

End Sub
已修改，试试

xiaolin1113

7171 发表于 2016-12-19 19:00
Sub t()
'把代码放到新的Excel文件中运行

您好，为什么运行完毕以后，excel表格打开为灰色，里面没有内容，谢谢！

7171

xiaolin1113 发表于 2016-12-19 22:58
您好，为什么运行完毕以后，excel表格打开为灰色，里面没有内容，谢谢！

'.Windows(1).Visible = True  此句前面多了个  '删除即可

xiaolin1113

7171 发表于 2016-12-19 19:00
Sub t()
'把代码放到新的Excel文件中运行

真的可以，太感谢了！