マクロメモ
Option Explicit
Sub CopyDataAndSaveNewWorkbook()
Dim SourceFolder As String
Dim SourceFile As String
Dim NewWorkbook As Workbook
Dim Pathtest As Object
Dim Filename As String
Dim wb As Workbook
Set Pathtest = ThisWorkbook.ActiveSheet.Cells(2, 1) ' 指定のフォルダのパスを設定
SourceFolder = Pathtest.Value ' フォルダのパスを変更
Filename = Dir(SourceFolder & "*.xlsx")
MsgBox "1" & SourceFolder
MsgBox "2" & Filename
Do While Filename <> ""
Dim WFna As String
WFna = Dir(SourceFolder & "*ABC.xlsx")
Workbooks.Open Filename:=SourceFolder & WFna
' ファイル名の末尾に「ABC」が含まれている場合にファイルを開く
' If Right(Filename, 4) = "ABC" Then
' Set wb = Workbooks.Open(SourceFolder & Filename)
' ここでファイルごとの処理を行うことができます
' 例: ファイルを開いた後、データの操作など
' ファイルを閉じる
' wb.Close SaveChanges:=False
' MsgBox "1" & SourceFolder
' MsgBox "2" & Filename
' Exit Do
' End If
Filename = Dir
MsgBox "4" & Filename
Loop
MsgBox "3" & Filename
' フォルダ内の最新のExcelファイルを検索
' SourceFile = Dir(SourceFolder & "*.xlsx")
' Do While SourceFile <> ""
' If FileDateTime(SourceFolder & SourceFile) > FileDateTime(SourceFolder & SourceFile) Then
' SourceFile = SourceFolder & SourceFile
' End If
' SourceFile = Dir
' Loop
MsgBox SourceFile
Dim Awb As Workbook
Set Awb = ActiveWorkbook
Set NewWorkbook = Workbooks.Add
' データをコピー
Awb.Worksheets(1).Range("A:J").Copy Awb.Worksheets(1).Range("A1")
' 最新のExcelファイルを開く
' Workbooks.Open SourceFile
Set Awb = ActiveWorkbook
Awb.Worksheets("Sheet1").Range("A1").PasteSpecial
' 新しいブックに名前を付けて保存
NewWorkbook.SaveAs "C:\Users\fafur\OneDrive\ドキュメント\excel練習\test\NewWorkbook.xlsx" ' 保存パスとファイル名を変更
NewWorkbook.Close
End Sub
Power Automate メモ
チームにエクセルのデータを送信するやり方
参照したページメモ
=VLOOKUP(MONTH(TODAY()), A2:B13, 2, FALSE)
顔面神経麻痺 ~違和感から一週間の経過~【1日目~7日目】
このブログを見に来た方は、顔面神経麻痺と診断された方や、現在治療中の方が多いかと思います。
私も先日顔面神経麻痺と診断されました。
いつ治るのか、後遺症は残らないのかなど、不安のなか治療を受けています。皆さんに少しでも情報を共有できたらなと思い記録を残していきたいと思います。
続きを読む