我每个月都会写一份月度日记，将数据从每日工作簿复制到另一张纸上。
我有当天的代码。它打开和关闭当天的工作表。
我不想打开和关闭文件，而是执行一个月的数据，因此它会获取该月文件夹中所有工作表中的所有数据。
Sub getlatestfilename()
Dim F As String, folder As String, currentyear As Integer, currentmonth As String, foldername As String, myfile As String
Dim LatestFile As String, filetoopen As String
Dim LatestDate As Date
Dim LMD As Date
Dim LR As Long
Dim datawb As Workbook, thiswb As Workbook, ws As Worksheet
' uncomment below once happy it runs
Application.ScreenUpdating = False
Set thiswb = ActiveWorkbook
currentyear = Year(Date)
currentmonth = Format(Month(Date), "00")
folder = "K:\Finance\Protected Funding Sheets\Barclays cash funding\Daily Funding Calculation\" & currentyear '& "\"
F = Dir(folder & "\*", vbDirectory)
Do While F <> ""
If InStr(F, currentmonth) > 0 Then
foldername = F
'Debug.Print foldername
folder = folder & "\" & foldername & "\"
Exit Do
End If
F = Dir
Loop
' check the month folder has been found
If F = "" Then
MsgBox "No " & currentmonth & " folder found..... ", vbExclamation
Exit Sub
End If
'Debug.Print folder
'Make sure that the path ends in a backslash
If Right(folder, 1) <> "\" Then folder = folder & "\"
'Get the first Excel file from the folder
myfile = Dir(folder & "*.xlsx", vbNormal)
'If no files were found, exit the sub
If Len(myfile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(myfile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(folder & myfile)
'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = myfile
LatestDate = LMD
End If
'Get the next Excel file from the folder
myfile = Dir
Loop
'Debug.Print LatestFile, LatestDate,
filetoopen = folder & LatestFile
'Debug.Print filetoopen
Set datawb = Workbooks.Open(filetoopen, Password:="barclays")
'select the correct sheet
'change sheetname to what is used in the file
'datawb.Sheets("sheetname").Activate
With datawb.Sheets("Journal")
date1 = .Range("B1")
date2 = .Range("C1")
bca = .Range("C16")
bcabs41 = .Range("H19")
bcabs42 = .Range("H20")
csh = .Range("K15")
cshbs42 = .Range("O15")
cshbs43 = .Range("O16")
cshbs432 = .Range("O18")
cshbs44 = .Range("O19")
'add the other required cells
End With
datawb.Close savechanges = False
Set ws = thiswb.Sheets("Postings")
ws.Activate
'For understanding LR = Last Row
'add variables data to the last row + 1
With ws
LR = .Cells(Rows.Count, 1).End(xlUp).Row
'add the saved variables
.Cells(LR + 1, 1) = date1
.Cells(LR + 1, 2) = date2
.Cells(LR + 1, 3) = bca
.Cells(LR + 1, 4) = bcabs41
.Cells(LR + 1, 5) = bcabs42
.Cells(LR + 1, 6) = csh
.Cells(LR + 1, 7) = cshbs42
.Cells(LR + 1, 8) = cshbs43
.Cells(LR + 1, 9) = cshbs432
.Cells(LR + 1, 10) = cshbs44
'add the other required cells
End With
Application.ScreenUpdating = True
End Sub
您已经有一段循环遍历文件夹中所有文件的代码：
'Loop through each Excel file in the folder
Do While Len(myfile) > 0
...
Loop
不要只在该循环中分配
LatestFile Sub getlatestfilename()
Dim F As String, folder As String, currentyear As Integer, currentmonth As String, foldername As String, myfile As String
Dim LatestFile As String, filetoopen As String
Dim LatestDate As Date
Dim LMD As Date
Dim LR As Long
Dim datawb As Workbook, thiswb As Workbook, ws As Worksheet
' uncomment below once happy it runs
Application.ScreenUpdating = False
Set thiswb = ActiveWorkbook
currentyear = Year(Date)
currentmonth = Format(Month(Date), "00")
folder = "K:\Finance\Protected Funding Sheets\Barclays cash funding\Daily Funding Calculation\" & currentyear '& "\"
F = Dir(folder & "\*", vbDirectory)
Do While F <> ""
If InStr(F, currentmonth) > 0 Then
foldername = F
'Debug.Print foldername
folder = folder & "\" & foldername & "\"
Exit Do
End If
F = Dir
Loop
' check the month folder has been found
If F = "" Then
MsgBox "No " & currentmonth & " folder found..... ", vbExclamation
Exit Sub
End If
'Debug.Print folder
'Make sure that the path ends in a backslash
If Right(folder, 1) <> "\" Then folder = folder & "\"
'Get the first Excel file from the folder
myfile = Dir(folder & "*.xlsx", vbNormal)
'If no files were found, exit the sub
If Len(myfile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(myfile) > 0
filetoopen = folder & myfile
'Debug.Print filetoopen
Set datawb = Workbooks.Open(filetoopen, Password:="barclays")
'select the correct sheet
'change sheetname to what is used in the file
'datawb.Sheets("sheetname").Activate
With datawb.Sheets("Journal")
date1 = .Range("B1")
date2 = .Range("C1")
bca = .Range("C16")
bcabs41 = .Range("H19")
bcabs42 = .Range("H20")
csh = .Range("K15")
cshbs42 = .Range("O15")
cshbs43 = .Range("O16")
cshbs432 = .Range("O18")
cshbs44 = .Range("O19")
'add the other required cells
End With
datawb.Close savechanges = False
Set ws = thiswb.Sheets("Postings")
ws.Activate
'For understanding LR = Last Row
'add variables data to the last row + 1
With ws
LR = .Cells(Rows.Count, 1).End(xlUp).Row
'add the saved variables
.Cells(LR + 1, 1) = date1
.Cells(LR + 1, 2) = date2
.Cells(LR + 1, 3) = bca
.Cells(LR + 1, 4) = bcabs41
.Cells(LR + 1, 5) = bcabs42
.Cells(LR + 1, 6) = csh
.Cells(LR + 1, 7) = cshbs42
.Cells(LR + 1, 8) = cshbs43
.Cells(LR + 1, 9) = cshbs432
.Cells(LR + 1, 10) = cshbs44
'add the other required cells
End With
'Get the next Excel file from the folder
myfile = Dir
Loop
Application.ScreenUpdating = True
End Sub