[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シート名変更について』(真由美)
いつも大変お世話になっております
教えて頂けたら嬉しいです
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
標準モジュールで使ってみてください。
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
「経費明細表」の文字の前に全角スペースが無かった場合
「経費明細表」の文字の前に半角スペースが入っている場合
に対応しています。
1枚目から7枚目のシートに対象のシートがある前提で書いてます。
ご参考まで。
(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
???様
いつも大変お世話になっております
有難う御座います
(真由美) 2017/01/13(金) 16:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.