excel-VBA：ダイナミックなパスと名前を持つ最後の列をコピーする

Question

私は、他の人が見ているxlsmがディレクトリ内のすべての.xslxファイルを実行し、サブを実行して保存します。 （ありがとうTabias） このサブの中で私は今、3番目のファイルの最後の列を追加するものを追加しようとしています。 私の最初の問題は、ソースファイルを定義する方法です。私たちは、正確なファイルから同様の名前でデータを取得する必要があります。だから、MC12february.xlsxとKA.xlsxからコピーするMC.xslxのAHSはKAwhateverdate.xlsx

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

からインポートする必要があり、残念ながら、active.workbook.nameは拡張子が含まれるため、ORあなたたちは私の解決策を伝えることができ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

補足として、検索したい文字列としてファイル名を指定できる、シンプルで再利用可能なファイルオープン関数を作成することをお勧めします。この関数は、ディレクトリ（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前にワイルドカード文字を削除することで渡す文字列を開始しなければならない。この方法を微調整することができます。使用するには、単にあなたが開くしたい「MC」または任意の一般的なファイル名を渡し、opnWB関数を呼び出します：

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) 

は、この情報がお役に立てば幸いです。