[[20170113134331]]　『シート名変更について』（真由美）　ページの最後に飛ぶ

『シート名変更について』（真由美）

いつも大変お世話になっております
教えて頂けたら嬉しいです

1ブックに複数シートがあります

シート名　基本は　県名＋全角スペース＋経費明細表　とお願いしてるのですが
スペースを入れていただけない方が　いらっしゃって困っています

シート名を判断して　スペースを入れるようなマクロを教えて下さい
若しくは　下記の様に書いてあるマクロを
スペースがあっても無くても同じように動く条件の書き方
を教えて下さい

Sub B()

   Sheets("茨城　経費明細表").Select
   Range("C6").Copy Range("A13")
   n = Cells(Rows.Count, "B").End(xlUp).Row
   Range("A13").Select
   Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault
   Rows("1:11").Delete Shift:=xlUp

    Sheets("広島　経費明細表").Select
    Range("C6").Copy Range("A13")
    n = Cells(Rows.Count, "B").End(xlUp).Row
    Range("A13").Select
    Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault
    Rows("1:11").Delete Shift:=xlUp

    Sheets("岡山　経費明細表").Select
    Range("C6").Copy Range("A13")
    n = Cells(Rows.Count, "B").End(xlUp).Row
    Range("A13").Select
    Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault
    Rows("1:11").Delete Shift:=xlUp

    Sheets("佐賀　経費明細表").Select
    Range("C6").Copy Range("A13")
    n = Cells(Rows.Count, "B").End(xlUp).Row
    Range("A13").Select
    Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault
    Rows("1:11").Delete Shift:=xlUp

    Sheets("東京　経費明細表").Select
    Range("C6").Copy Range("A13")
    n = Cells(Rows.Count, "B").End(xlUp).Row
    Range("A13").Select
    Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault
    Rows("1:11").Delete Shift:=xlUp

    Sheets("兵庫　経費明細表").Select
    Range("C6").Copy Range("A13")
    n = Cells(Rows.Count, "B").End(xlUp).Row
    Range("A13").Select
    Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault
    Rows("1:11").Delete Shift:=xlUp

    Sheets("静岡　経費明細表").Select
    Range("C6").Copy Range("A13")
    n = Cells(Rows.Count, "B").End(xlUp).Row
    Range("A13").Select
    Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault
    Rows("1:11").Delete Shift:=xlUp

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 スペース関係なし案

 Sub B()

     Dim ws As Worksheet

     For Each ws In Worksheets
         If ws.Name Like "*経費明細表*" Then
            ws.Range("C6").Copy ws.Range("A13")
            n = ws.Cells(Rows.Count, "B").End(xlUp).Row
            ws.Range("A13").AutoFill Destination:=ws.Range("A13:A" & n), Type:=xlFillDefault
            ws.Rows("1:11").Delete Shift:=xlUp
         End If
     Next

 End Sub
（bi） 2017/01/13(金) 14:12

bi様
有難う御座います
又お願いすることが出てくると思いますが
宜しくお願いいたします
（真由美） 2017/01/13(金) 14:30

解決済かもしれませんし、きれいなコードではないんですが(笑)
シート名を変更するコードを書いてみました。

標準モジュールで使ってみてください。

Sub Sumple()
Dim i As Long
Dim mySheet As Worksheet
Dim myRow As Long

    myRow = 1

    Worksheets.Add after:=Worksheets(Worksheets.Count) '末尾にシートを追加します

    For Each mySheet In Worksheets　'末尾のシートA1から下にシート名を取得します
        Worksheets(Worksheets.Count).Cells(myRow, 1).Value = mySheet.Name
        myRow = myRow + 1
    Next

    For i = 1 To 7　'取得したシート名の値を右から調べてシート名に全角スペースを入れます
        If Right(Cells(i, 1), 6) = " 経費明細表" Then
            Cells(i, 1) = Replace(Cells(i, 1), " 経費明細表", "　経費明細表")
        ElseIf Right(Cells(i, 1), 6) <> "　経費明細表" Then
            Cells(i, 1) = Replace(Cells(i, 1), "経費明細表", "　経費明細表")
        End If
        Sheets(i).Name = Range("A" & i)
    Next

    Application.DisplayAlerts = False　'末尾に作成したシートを削除します
    Worksheets(Worksheets.Count).Delete
    Application.DisplayAlerts = True

End sub

「経費明細表」の文字の前に全角スペースが無かった場合
「経費明細表」の文字の前に半角スペースが入っている場合
に対応しています。

１枚目から７枚目のシートに対象のシートがある前提で書いてます。

ご参考まで。
（pooh） 2017/01/13(金) 15:53

蛇足ながら、シート名を揃えるだけのマクロ例。

 Sub test()
    Dim i As Long
    Dim cw As String

    For i = 1 To Sheets.Count
        With Sheets(i)
            If .Name Like "*経費明細表*" Then
                cw = Replace(.Name, "　", " ")
                cw = Trim(Replace(cw, "経費明細表", "")) & "　経費明細表"
                If .Name <> cw Then
                    .Name = cw
                End If
            End If
        End With
    Next i
 End Sub
（???） 2017/01/13(金) 16:24

pooh様
有難う御座います

???様
いつも大変お世話になっております
有難う御座います
（真由美） 2017/01/13(金) 16:30

コメント返信：

[ 一覧(最新更新順) ]

[[20170113134331]] 『シート名変更について』（真由美） ページの最後に飛ぶ

[[20170113134331]]　『シート名変更について』（真由美）　ページの最後に飛ぶ