• 締切済み

エクセル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

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17070)
回答No.1

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

nebikitorikai
質問者

お礼

有難うございます

nebikitorikai
質問者

補足

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

関連するQ&A