excel-VBA：複製最後一列的動態路徑和名稱

Question

我有一個xlsm，其他人通過目錄中的所有.xslx文件運行，運行一個子，保存它們。 （謝謝Tabias） 在這個子內我現在試圖添加一些東西，將添加第三個文件的最後一列。 我的第一個問題是如何定義源文件。我們需要從確切的文件中獲取數據，並使用相似的名稱。所以MC.xslx AHS從MC12february.xlsx複製和KA.xlsx必須從KAwhateverdate.xlsx進口

Set wbA = Workbooks.Open("C:\files" & "\" & ActiveWorkbook.Name & "*.xlsx") 

不幸的是，active.workbook.name包括進一步擴展，所以OR你們能告訴我一個解決方案或我必須先保存文件日期+名稱並將其更改爲wbA = Workbooks.Open("C:\files" & "\*" & ActiveWorkbook.Name)對不對？

表單也一樣。這些將根據文件被稱爲MC，KA，KC，... 接下來，因爲我只想將文件的最後一列複製到另一個文件的最後一列，所以我很困惑。 I found this code，並認爲這是最容易理解的。

Sub import() 

Dim Range_to_Copy As Range 
Dim Range_Destination As Range 

Dim Sheet_Data As Worksheet 'sheet from where we pull the data 
Dim Sheet_Destination As Worksheet ' destination 
Dim workbook_data As Workbook 
Dim workbook_destination As Workbook 



Set workbook_data = "N:\blah\deposit" & "\*" & ActiveWorkbook.Name 
Set workbook_detination = ActiveWorkbook 
Set Sheet_Data = ThisWorkbook.Sheets("Sheet1") 'help, how do i do this? 
Set Sheet_Destination = ThisWorkbook.Sheets("Sheet1") ' and this? 

Set Range_to_Copy = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row 

Set Range_Destination = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row 

Range_to_Copy.Copy Range_Destination 'this copies from range A to B (basically A.copy B), but i changed variable names to make it easier... 


'you can simplify without variables like this: 
'Sheets("Sheet1").Range("D1").Copy Sheets("Summary).Range("A1")   <===== does the same as the above coding 

沒有更簡單的解決方案似乎也適合。 example

正如你所看到的，我完全停留在如何定義最後一列和工作表名稱上。這段代碼對我來說是不完整的。有人能讓我走上正確的道路嗎？謝謝。

Answer 1

作爲補充，我建議創建一個simeple，可重用的文件打開功能，您可以提供一個文件名作爲您想要搜索的字符串。該函數將循環訪問一個目錄（如Batman建議的那樣），並且可以選擇使用該文件的最新版本（使用修改日期）。以下是我經常使用的一組功能。有一個子文件夾參數「subF」，它允許您在子文件夾內搜索相對於當前文件位置的文件夾。

'FUNCTION opnWB 
'--Opens a workbook based on filename parameter 
'----WILDCARDS before and after the filename are used to allow for filename flexibility 
'----Subfolder is an OPTIONAL PARAMETER used if the location of the file is located in a subfolder 
Public Function opnWB(ByVal flNM As String, Optional ByVal subF As String = "") As Workbook 
    If subF <> "" Then subF = "\" & subF 

    Dim pthWB As String 
     pthWB = "\*" & flNM & "*" 'wildcard characters before and after filename 
     pthWB = filePull(subF, pthWB) 

    Set opnWB = Workbooks.Open(ActiveWorkbook.path & subF & "\" & pthWB, UpdateLinks:=0) 

End Function 
'FUNCTION filePull 
'--Cycles through folder for files that match the filename parameter (with WILDCARDS) 
'--If there is more than one file that matches the filename criteria (with WILDCARDS), 
'----the file "Date Modified" attribute is used and the most recent file is "selected" 
Private Function filePull(ByVal subF As String, ByVal path As String) As String 
    Dim lDate, temp As Date 
    Dim rtrnFl, curFile As String 

    Filename = Dir(ActiveWorkbook.path & subF & path) 
    Do While Filename <> "" 
     curFile = Filename 
     curFile = ActiveWorkbook.path & subF & "\" & Filename 

     If lDate = 0 Then 
      rtrnFl = Filename 
      lDate = GetModDate(curFile) 
     Else 
      temp = GetModDate(curFile) 
     End If 

     If temp > lDate Then 
      rtrnFl = Filename 
      lDate = temp 
     End If 

     Filename = Dir() 
    Loop 

    filePull = rtrnFl 

End Function 
'FUNCTION GetModDate 
'--Returns the date a file was last modified 
Public Function GetModDate(ByVal filePath As String) As Date 
    GetModDate = CreateObject("Scripting.FileSystemObject").GetFile(filePath).DateLastModified 
End Function 

你可以調整這個方法，其中的文件名必須啓動文件，你在通過flNM之前簡單地刪除通配符傳遞字符串。要使用，只需將調用opnWB功能，傳遞「MC」或任何一般的文件名，你想開：

Dim wbTarMC as Workbook 
Set wbMC = opnWB("MC", "Source Files") 'this would open up MC.xlsx file within the subfolder "Source Files" (relative to current file location) 

希望這有助於。