ちょこっとVBA
Sub test_p()
Application.DisplayAlerts = False ' メッセージを非表示
Dim wb As Workbook
Set wb = Workbooks.Add ' ブックを作成
Dim wb2 As Workbook
Dim buf As String, cnt As Long, cnt2, cnt3, i, j, k As Long
Const Path As String = "C:\Users\gold_love\excel_テスト\"
buf = Dir(Path & "*.xlsx")
Do While buf <> ""
Set wb2 = Workbooks.Open(Path & buf, ReadOnly:=True)
cnt = cnt + 1
wb2.Worksheets("Sheet1").Cells(1, 2).Copy wb.Worksheets("Sheet1").Cells(cnt, 1)
cnt3 = Cells(1, 4).End(xlDown).Row + 1
MsgBox cnt3
'セルの行数（行位置）を取得するには、
cnt2 = Cells(5, 4).End(xlDown).Row
MsgBox cnt2
k = k + 1
For j = cnt3 To cnt2
'If j = cnt2 + 1 Then
' Exit For
'End If
'MsgBox Cells(j, 4)
'Cells(1, k) = Cells(j, 4)
'k = k + 1
Select Case Cells(j, 4)
Case 0
wb.Worksheets("Sheet1").Cells(k, 2) = wb.Worksheets("Sheet1").Cells(k, 2) + 1
Case 1
wb.Worksheets("Sheet1").Cells(k, 3) = wb.Worksheets("Sheet1").Cells(k, 3) + 1
Case 2
wb.Worksheets("Sheet1").Cells(k, 4) = wb.Worksheets("Sheet1").Cells(k, 4) + 1
Case 3
wb.Worksheets("Sheet1").Cells(k, 5) = wb.Worksheets("Sheet1").Cells(k, 5) + 1
Case 4
wb.Worksheets("Sheet1").Cells(k, 6) = wb.Worksheets("Sheet1").Cells(k, 6) + 1
Case 5
wb.Worksheets("Sheet1").Cells(k, 7) = wb.Worksheets("Sheet1").Cells(k, 7) + 1
Case 6
wb.Worksheets("Sheet1").Cells(k, 8) = wb.Worksheets("Sheet1").Cells(k, 8) + 1
Case 7
wb.Worksheets("Sheet1").Cells(k, 9) = wb.Worksheets("Sheet1").Cells(k, 9) + 1
Case 8
wb.Worksheets("Sheet1").Cells(k, 10) = wb.Worksheets("Sheet1").Cells(k, 10) + 1
Case Else
Debug.Print "1から9までの値を指定してください"
End Select
Next
wb2.Close SaveChanges:=False
'cnt = cnt + 1
'Cells(cnt, 1) = buf
buf = Dir()
Loop
i = Cells(1, 1).End(xlDown).Row + 1
'Cells(i, 1) = "合計"
A列の指定範囲の空白セルのみ選択
Range(Cells(1, 2), Cells(i - 1, 10)).SpecialCells(xlCellTypeBlanks).Select
選択セルに×を書込み
Selection = 0
Dim r As Long
'r = Range("B1").End(xlDown).Row + 1
Range("A" & i) = "合計"
With Range("B" & i)
.Formula = "=SUM(B1:B" & (i - 1) & " )"
.AutoFill Destination:=.Resize(1, 9)
End With
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 2) = "あかさたな"
Cells(1, 3) = "いきしちに"
Cells(1, 4) = "うくすつぬ"
Cells(1, 5) = "えけせてね"
Cells(1, 6) = "おこそとの"
Cells(1, 7) = "はまな"
Cells(1, 8) = "たんこぐ"
Cells(1, 9) = "よたれそつ"
Cells(1, 10) = "わおうん"
Range("B1:J1").Select
With Selection
'.HorizontalAlignment = xlCenter
'.VerticalAlignment = xlCenter
'.WrapText = False
.Orientation = xlVertical
'.AddIndent = False
'.IndentLevel = 0
'.ShrinkToFit = False
'.ReadingOrder = xlContext
'.MergeCells = False
End With
'Columns("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
'.WrapText = False
'.Orientation = 0
'.AddIndent = False
'.IndentLevel = 0
'.ShrinkToFit = False
'.ReadingOrder = xlContext
'.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Range("A1").Select
Call wb.SaveAs("C:\Users\gold_love\excel_テスト\New_Book.xlsx") ' 名前を付けて保存
Call wb.Close(SaveChanges:=True) ' 変更を保存して閉じる
Application.DisplayAlerts = True ' メッセージを表示
End Sub