こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

エクセルVBA全シートに差し込みマクロ構文

Sheets("震圧データ").Select
MsgBox "新規ブックに年月分けて" & vbCrLf & "震圧データを転記します、" & vbCrLf & "お待ちください。"
Dim c As Range
Dim i As Integer
Dim LastRow As Long
Dim NewSheetName As String, MatchFlag As Boolean
Application.ScreenUpdating = False
Workbooks.Add
With ThisWorkbook.Sheets("震圧データ")
For Each c In .Range(.Cells(4, "A"), .Cells(Rows.Count, "A").End(xlUp))
If NewSheetName <> Year(c.Value2) & "年" & Month(c.Value2) & "月" Then
NewSheetName = Year(c.Value2) & "年" & Month(c.Value2) & "月"
If c.Row - 2 > Sheets.Count Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Else
Sheets(c.Row - 2).Select
End If
ActiveSheet.Name = NewSheetName
Sheets(NewSheetName).Range("A1").Value = "年月日"
Sheets(NewSheetName).Range("B1").Value = "曜日"
Sheets(NewSheetName).Range("C1").Value = "A"
Sheets(NewSheetName).Range("D1").Value = "B"
Sheets(NewSheetName).Range("E1").Value = "C"
Sheets(NewSheetName).Range("F1").Value = "時間"
Sheets(NewSheetName).Range("G1").Value = "状態"
Sheets(NewSheetName).Range("I1").Value = "No.1"
Sheets(NewSheetName).Range("I2").Value = "記録者"
Sheets(NewSheetName).Range("I3").Value = "氏名:"
Sheets(NewSheetName).Range("I4").Value = "=IF(ISBLANK(A4),"""",DATEDIF("""",Today(),""Y"") & ""歳"")"
Sheets(NewSheetName).Range("I5").Value = "=""転載日"""
Sheets(NewSheetName).Range("I6").Value = "=TODAY()"
Sheets(NewSheetName).Range("I56").Value = "=IF(ISBLANK(A56),"""",""No.2"")"
Sheets(NewSheetName).Range("I57").Value = "=IF(ISBLANK(A56),"""",""記録者"")"
Sheets(NewSheetName).Range("I58").Value = "=IF(ISBLANK(A56),"""", ""氏名:"")"
Sheets(NewSheetName).Range("I59").Value = "=IF(ISBLANK(A56),"""",DATEDIF("""",Today(),""Y"") & ""歳"")"
Sheets(NewSheetName).Range("I60").Value = "=IF(ISBLANK(A56),"""",""転載日"")"
Sheets(NewSheetName).Range("I61").Value = "=IF(ISBLANK(A56),"""",TODAY())"
Sheets(NewSheetName).Range("I111").Value = "=IF(ISBLANK(A111),"""",""No.3"")"
Sheets(NewSheetName).Range("I112").Value = "=IF(ISBLANK(A111),"""",""記録者"")"
Sheets(NewSheetName).Range("I113").Value = "=IF(ISBLANK(A111),"""", ""氏名:"")"
Sheets(NewSheetName).Range("I114").Value = "=IF(ISBLANK(A111),"""",DATEDIF("""",Today(),""Y"") & ""歳"")"
Sheets(NewSheetName).Range("I115").Value = "=IF(ISBLANK(A111),"""",""転載日"")"
Sheets(NewSheetName).Range("I116").Value = "=IF(ISBLANK(A111),"""",TODAY())"
Sheets(NewSheetName).Range("I166").Value = "=IF(ISBLANK(A166),"""",""No.4"")"
Sheets(NewSheetName).Range("I167").Value = "=IF(ISBLANK(A166),"""",""記録者"")"
Sheets(NewSheetName).Range("I168").Value = "=IF(ISBLANK(A166),"""", ""氏名"")"
Sheets(NewSheetName).Range("I169").Value = "=IF(ISBLANK(A166),"""",DATEDIF("""",Today(),""Y"") & ""歳"")"
Sheets(NewSheetName).Range("I170").Value = "=IF(ISBLANK(A166),"""",""転載日"")"
Sheets(NewSheetName).Range("I171").Value = "=IF(ISBLANK(A166),"""",TODAY())"
Sheets(NewSheetName).Range("H1").Value = "提出済○"
Sheets(NewSheetName).Range("A57").Select
Range("I6,I61,I116").Select
Range("I6,I61,I116,I171").Select
Selection.NumberFormatLocal = "yyyy/m/d"
Columns("F:F").Select
Selection.NumberFormatLocal = "[$-409]h:mm AM/PM;@"
Range("G1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
LastRow = Sheets(NewSheetName).Cells(Rows.Count, "A").End(xlUp).Row
Sheets(NewSheetName).Cells(LastRow + 1, "A").Resize(1, 8).Value = .Cells(c.Row, "A").Resize(1, 8).Value
Sheets(NewSheetName).Columns("A:I").EntireColumn.AutoFit
Next
新規ブック最終シートのみ適用できますが他の月別シートに適用できておりません
'↓どのような構文にしたら適用されるのでしょうか?ここからが質問です↓
If Sheets(NewSheetName).Range("A56") = "" Then
Range("I56:I171").Delete
Else
Sheets(NewSheetName).Range("A56").Value = "年月日"
Sheets(NewSheetName).Range("B56").Value = "曜日"
Sheets(NewSheetName).Range("C56").Value = "A"
Sheets(NewSheetName).Range("D56").Value = "B"
Sheets(NewSheetName).Range("E56").Value = "C"
Sheets(NewSheetName).Range("F56").Value = "時間"
Sheets(NewSheetName).Range("G56").Value = "状態"
End If 'ここまで! どなたかご教示お願いします
.Activate
End With

投稿日時 - 2018-01-06 16:03:48

QNo.9415506

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

標準モジュールに
Sub test01()
For Each sh In Worksheets
MsgBox sh.Name
Next
End Sub
でシート全部の名前を表示できる。
だから
Sheets(NewSheetName).Range・・などの
Sheets(NewSheetName)をShで置き変えれば全シートのそのセルに処理(右辺に = "状態"などすれば、値代入など)を繰り返してくれる。
質問は長くてくだくだしているが、これで済むのでは。
コードをコピペして手を抜くのでなく、質問には、文章でも、したいことを表現してほしい。本件では「全シートに」で推測したが。
差し込み印刷は、エクセルでは特別に限定した機能なので、安易に使わず、たとえば「差し込み印刷のような処理なら」そう断るべきだろう。

投稿日時 - 2018-01-06 18:29:31

補足

説明不足ですみません、シートの検索ではなく又差し込み印刷でもありません。1年間入力したブックから新規ブックのシートに各月に分けて書き出されたデータでRange("A56:I56")以下にもデータがあるシートのみにA56:I56に左から年月日、曜日、A,B,C,時間、状態を行を挿入して入力したいのです。これを印刷すると改ページの先頭に年月日、曜日、A,B,C,時間、状態となるようにしたいのです。宜しくお願いします。

投稿日時 - 2018-01-07 20:23:04

お礼

有難うございます

投稿日時 - 2018-01-07 20:23:18

あなたにオススメの質問

オススメのQ&Aはありません。