카테고리 없음

엑셀 VBA 시트명 일괄 변경

낌준희 Kkimjunhee 2024. 9. 10. 16:17
반응형

Sub ChangeSheetNamesInFolder()
    Dim folderPath As String
    Dim fileName As String
    Dim newFileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Integer
    
    ' 폴더 경로 설정 (경로 끝에 \를 꼭 추가하세요)
    folderPath = "C:\Users\KJH_7JS2\Downloads\새 폴더 (27)\" ' 폴더 경로를 변경하세요
    
    ' 폴더 내 첫 번째 파일 가져오기
    fileName = Dir(folderPath & "*.xls*") ' .xls, .xlsx, .xlsm 등 확장자
    
    ' 파일이 있는 동안 반복
    Do While fileName <> ""
        On Error Resume Next ' 오류 발생 시 무시하고 다음 단계로 진행
        
        ' 파일 열기
        Set wb = Workbooks.Open(folderPath & fileName, Local:=True)
        
        If Not wb Is Nothing Then ' 파일이 제대로 열렸는지 확인
            ' 시트명을 변경 (내용 손실 없이)
            i = 1 ' 번호 초기화 (필요에 맞게 조정 가능)
            For Each ws In wb.Worksheets
                On Error Resume Next ' 오류 발생 시 무시 (예: 시트명 중복)
                ws.Name = "Sheet" & i ' 시트명을 "Sheet1", "Sheet2" 등으로 변경
                On Error GoTo 0 ' 오류 무시 종료
                i = i + 1
            Next ws
            
            ' 웹페이지 형식 파일을 Excel 형식으로 다시 저장
            newFileName = folderPath & Left(fileName, InStrRev(fileName, ".") - 1) & ".xlsx"
            wb.SaveAs fileName:=newFileName, FileFormat:=xlOpenXMLWorkbook ' .xlsx 형식으로 저장
            wb.Close SaveChanges:=True
            
        End If
        
        On Error GoTo 0 ' 오류 무시 종료
        
        ' 다음 파일로 이동
        fileName = Dir
    Loop
    
    MsgBox "폴더 내 모든 파일의 시트명이 변경되고 엑셀 형식으로 저장되었습니다."
End Sub

 

 

#엑셀

#VBA

#EXCEL

반응형