Excelを使わないようにしようと思った時期もあったが、それは無理とわかった。
Excelを諦めるのを諦めた。
必要があれば適度に使うことにした。

かなり前に作ったExcel VBAをメモしていく。

わざわざアプリケーションインストールするまでもない、と思いネットを探したが、思うようなのがなかったので作った。
統一がとれてなかったり、ダサダサなんだけど、まぁ、よしとするか。
特にDirとか書いているところ、この関数使わずに書き直したいんだけど。

Public Sub CopyAllSheets()
 
'CopyAllSheets New Excel Book VBA
 
'指定したブック(Excelファイル)のシート、またそれと同じフォルダ内のブックのシートをこのブックにコピーするマクロ
'シート名に重複があるときはシート名(2)という具合にコピーする
'結果はシート名で昇順に並び変える。また空シートは削除する(コピーしない)
 
'*** 注意 *** 2007形式のブック(ファイル)を対象にする時は、本ブック(ファイル)を xlsm(マクロ有効な2007ブック形式)形式で保存しなおすこと
 
'画面の表示更新を止める(処理を速くするために)
Application.ScreenUpdating = False
 
'ダミーシート作成(Excelブックは最低1シートは存在してなければいけない)
Dim sh1 As Worksheet
Dim flag As Boolean
For Each sh1 In Worksheets
    If sh1.Name = "dummy0123456789" Then flag = True
Next sh1
If flag = False Then
   Worksheets.Add
   ActiveSheet.Name = "dummy0123456789"
End If
 
'既存シート削除
Dim sh2 As Worksheet
With ThisWorkbook.Sheets
    For Each sh2 In Sheets
        If Not (sh2.Name = "dummy0123456789") Then
            Application.DisplayAlerts = False
            sh2.Delete
            Application.DisplayAlerts = True
        End If
    Next
End With
 
'各ブックの各シートをコピー
Dim strPath As String
Dim index As Integer
Dim strFName As String
 
strPath = Application.GetOpenFilename
 
If strPath = "False" Then
    Exit Sub
End If
 
index = InStrRev(strPath, "\")
strPath = Left(strPath, index)
 
'シートのコピー
strFName = Dir(strPath & "*.xls*") '拡張子が2007タイプでも読み込むように。
'' 自分自身の(マクロを実行している)ブック名を取得
myfile = ThisWorkbook.Name
Do While strFName <> "" And strFName <> myfile  '自分自身はコピーの対象としない
        CopySheetsInBook (strFName)
        strFName = Dir()
Loop
 
' ダミーシート削除(空のワークシート削除より前で処理すること)
Application.DisplayAlerts = False   'メッセージを表示しない
With ThisWorkbook.Sheets
    Worksheets("dummy0123456789").Delete
End With
Application.DisplayAlerts = True
 
'空のワークシートを削除
Dim sh3 As Worksheet
Application.DisplayAlerts = False   'メッセージを表示しない
With ThisWorkbook.Sheets
    For Each sh3 In Worksheets
        If IsEmpty(sh3.UsedRange) = True Then
            sh3.Delete
        End If
    Next sh3
End With
Application.DisplayAlerts = True
 
'シートの並び替え(昇順)
Dim i As Byte
Dim j As Byte
 
For i = 1 To Sheets.Count - 1                 '---最初から最後の1つ前のシートまで
  For j = i + 1 To Sheets.Count               '---i番め以降のシート全て
     If Sheets(i).Name > Sheets(j).Name Then  '---シート名の比較
        Sheets(j).Move Before:=Sheets(i)      '---(1)シートの移動
     End If
  Next j
Next i
 
'最初のシートをアクティブにする
Dim Sh4 As Worksheet
With ThisWorkbook.Sheets
    Set Sh4 = Worksheets(1)
    Sh4.Activate
End With
 
'処理結果をこのファイルに保存する
Application.DisplayAlerts = False   'メッセージを表示しない
Dim book1 As Workbook
Set book1 = ThisWorkbook
book1.Save
Application.DisplayAlerts = True
 
' 画面の表示更新を再開する
Application.ScreenUpdating = True
 
MsgBox "結果を保存し、処理が終了しました。"
 
End Sub
 
'シートのコピー(サブ)
Private Sub CopySheetsInBook(strFName As String)
 
Dim NumOfSheets As Integer
Dim iSheets As Worksheet
 
NumOfSheets = Workbooks(1).Sheets.Count
Workbooks.Open strFName
With Workbooks(2)
    For Each iSheets In .Sheets
        iSheets.Copy after:=Workbooks(1).Worksheets(NumOfSheets)
        NumOfSheets = NumOfSheets + 1
    Next
    .Saved = True
    .Close
End With
 
End Sub