Excelの配列に列全体をコピー

Question

ユーザーが入力した場所で指定されたExcelファイルを開くマクロを開発しようとしています。特定の列を見つけ、アクティブブックに列全体を貼り付けます。これまでは、ディレクトリ内のファイルをループし、ファイルを開き、列を検索し、列全体を配列に格納するコードを記述しました。今私は "オーバーフロー"と言ってランタイムエラーをしようとしているとき！誰も私がこの問題を解決するのを助けることができますか？また、私はマクロ内の項目の下に統合したい： 1.各ファイルから複数の列を見つけ、それらの列をシートに貼り付ける。したがって、複数のファイルの場合は、個々のワークシートに列を動的に貼り付ける必要があります。どうやってやるの？どんな助けもありがとうございます。ありがとう。以下は、私がこれまで書いてきた私のコードです：ここ

Sub Test_Template() 

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 

Dim wb As Workbook 
Dim myPath As String, myFile As String 
Dim myExtension As String 
Dim t As Range, rng As Range, rng2 As Range 
Dim dblAvg As Single, eng_spd As Single, i As Integer 
Dim FldrPicker As FileDialog 
Dim rowCtr As Integer 
Dim myarray1 As Variant 
rowCtr = 2 


'Optimize Macro Speed 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.Calculation = xlCalculationManual 

'Retrieve Target Folder Path From User 
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) 

    With FldrPicker 
     .Title = "Select A Target Folder" 
     .AllowMultiSelect = False 
     If .Show <> -1 Then GoTo NextCode 
     myPath = .SelectedItems(1) & "\" 
    End With 


'In Case of Cancel 
NextCode: 
    myPath = myPath 
    If myPath = "" Then GoTo ResetSettings 

'Target File Extension (must include wildcard "*") 
    myExtension = "*.xls*" 

'Target Path with Ending Extention 
    myFile = Dir(myPath & myExtension) 

'Loop through each Excel file in folder 
Execute: 
Do While myFile <> "" 
    'Set variable equal to opened workbook 
     Set wb = Workbooks.Open(Filename:=myPath & myFile) 

    'Ensure Workbook has opened before moving on to next line of code 
     DoEvents 

'Find "Time" in Row 1 
    With wb.Worksheets(1).Rows(9) 
    Set t = .Find("Time", lookat:=xlPart) 
'If found, copy the column to Sheet 2, Column A 
'If not found, present a message 
    If Not t Is Nothing Then 
     'Columns(t.Column).EntireColumn.Copy _ 
     ' Destination:=Sheets(3).Range("A1") 
    Set rng2 = Columns(t.Column) 
    myarray1 = rng2 
     Else: MsgBox "Time Not Found" 
    End If 
    End With 

'Save and Close Workbook 
     wb.Close 'SaveChanges:=True 

    'Ensure Workbook has closed before moving on to next line of code 
     DoEvents 

With ActiveSheet 
For i = LBound(myarray1) To UBound(myarray1) 
    Debug.Print myarray1(i, 1) 
Next 
End With 
    'Get next file name 
     myFile = Dir 
Loop 

'Message Box when tasks are completed 
    'MsgBox "Task Complete!" 

ResetSettings: 
    'Reset Macro Optimization Settings 
    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 


End Sub 

Answer 1

は乱雑で、あなたのコードは、後藤のコマンドのような、で、コマンドで使用されていないと、エラーを与える何行

Sub Test_Template() 

    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 

    Dim wb As Workbook 
    Dim myPath As String, myFile As String 
    Dim myExtension As String 
    Dim t As Range, rng As Range, rng2 As Range 
    Dim dblAvg As Single, eng_spd As Single, i As Long 
    Dim FldrPicker As FileDialog 
    Dim rowCtr As Long 
    Dim myarray1 As Variant 
    rowCtr = 2 


    ' Optimize Macro Speed 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.Calculation = xlCalculationManual 

    ' Retrieve Target Folder Path From User 
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) 

    With FldrPicker 
     .Title = "Select A Target Folder" 
     .AllowMultiSelect = False 
     If .Show = True Then 
      myPath = .SelectedItems(1) & "\" 
     End If 
    End With 


    myPath = myPath            ' In Case of Cancel 
    If myPath <> "" Then 

     myExtension = "*.xls*"         ' Target File Extension (must include wildcard "*") 

     myFile = Dir(myPath & myExtension)      ' Target Path with Ending Extention 

     Do While myFile <> ""          ' Loop through each Excel file in folder 

      Set wb = Workbooks.Open(Filename:=myPath & myFile) ' Set variable equal to opened workbook 

      DoEvents            ' yield processing time to other events 

      Set t = wb.Worksheets(1).Rows(9).Find("Time", lookat:=xlPart) ' Find "Time" in Row 1 ???? 

      If Not t Is Nothing Then 

'    Columns(t.Column).EntireColumn.Copy _ 
       Destination:=Sheets(3).Range("A1") 

       myarray1 = Columns(t.Column)      ' found: copy the column to Sheet 2, Column A 

      Else 
       MsgBox "Time Not Found" 
      End If 

      wb.Close ' SaveChanges:=True       ' Save and Close Workbook 

      DoEvents            ' yield processing time to other events 

      For i = LBound(myarray1) To UBound(myarray1) 
       Debug.Print myarray1(i, 1) 
      Next 

      myFile = Dir           ' Get next file name 
     Loop 

'  MsgBox "Task Complete!" 

    End If 

    'Reset Macro Optimization Settings 
    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 

End Sub