创建一个循环，从工作表的数量

Question

下午好，

我想读的CSV文件数量，并在新的工作簿加载它们复制结果行至一个新的工作表。然后创建代码来查找每列中最大的数字（即最大值）并粘贴到每列的底部。在这个论坛的帮助下，我已经完成了计算最大价值和粘贴拉斯特罗的阶段。

现在，我想他们在我创建并命名为我的代码导致一个新的工作转移。与以往的建议，我已经找到了如何在特定范围内粘贴一个列到另一个工作表用下面的例子：

Sub OneCell() 
    Sheets("Result").Range("E3:V3").Value = Sheets("HP5_1gs_120_2012.plt").Range("E3:V3").Value 
End Sub 

但不知道我怎么能循环这跟我现有的代码读取最后一行哪里我的最大值是（在图1中用黄色突出显示）并粘贴到结果表中，并将E列中的标题粘贴到最后一个可用列，将rowname作为工作表名称。对于每次运行，每个工作表的数据结构都是相同的。而且我的起始列始终是列“E”，但最后一列（即最后一列）对于每次运行都可能不同。这就是我对如何循环这一点感到非常困惑。因此，对于一个例子一个简单的数据集像下图（图1）：

我试图做到这一点（图2）：

我的主要代码如下：

Private Sub FilePath_Button_Click() 
get_folder 
End Sub 

Private Sub Run_Button_Click() 
load_file 
End Sub 

Public Sub get_folder() 

Dim FolderName As String 
With Application.FileDialog(msoFileDialogFolderPicker) 
    .AllowMultiSelect = False 
    .Show 
    On Error Resume Next 
    FolderName = .SelectedItems(1) 
    Err.Clear 
    On Error GoTo 0 
End With 
TextBox1.Text = FolderName 
End Sub 

Sub load_file() 
Dim strFile As String 
Dim ws As Worksheet 
Dim test As String 

Dim wb As Workbook 

test = TextBox1.Text 

strFile = Dir(Me.TextBox1.Text & "\*.csv") 

     Set wb = Workbooks.Add 
     'added workbook becomes the activeworkbook 
     With wb 
     Do While Len(strFile) > 0 

     Set ws = ActiveWorkbook.Sheets.Add 
     ws.Name = strFile 

With ws.QueryTables.Add(Connection:= _ 
    "TEXT;" & test & "\" & strFile, Destination:=Range("$A$1")) 
    .Name = strFile 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .TextFilePromptOnRefresh = False 
    .TextFilePlatform = 437 
    .TextFileStartRow = 1 
    .TextFileParseType = xlDelimited 
    .TextFileTextQualifier = xlTextQualifierDoubleQuote 
    .TextFileConsecutiveDelimiter = False 
    .TextFileTabDelimiter = False 
    .TextFileSemicolonDelimiter = False 
    .TextFileCommaDelimiter = True 
    .TextFileSpaceDelimiter = False 

    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 
strFile = Dir 
Loop 
End With 

Application.DisplayAlerts = False 
Worksheets("Sheet1").Delete 
Worksheets("Sheet2").Delete 
Worksheets("Sheet3").Delete 
Application.DisplayAlerts = True 

Dim ws1 As Worksheet 
Dim ColNo As Long, lc As Long 
Dim lastrow As Long 

    For Each ws1 In ActiveWorkbook.Worksheets 
     lastrow = Range("A1").End(xlDown).Row 
     lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 
     For ColNo = 5 To lc 
      ws1.Cells(lastrow + 2, ColNo).Formula = "=MAX(" & Split(Cells(, ColNo).Address, "$")(1) & "1:" & Split(Cells(, ColNo).Address, "$")(1) & lastrow & ")" 
     Next ColNo 
    Next ws1 

Dim ws2 As Worksheet 
Set ws2 = Sheets.Add 
Sheets.Add.Name = "Result" 

MsgBox "Job Complete" 
End Sub 



Private Sub UserForm_Click() 

End Sub 

我希望我已经设法解释了我想要达到的目标，我真的很感谢任何指导是。下面感谢

Answer 1

有点像应该这样做。毫无疑问，你会想调整位数，但总体结构在那里。我已经评论了每个区块在做什么 - 确保您了解每条线路。

但通常询问的问题你应该真正打破的问题分解成各个部分。

像 - “我怎么通过环片”，然后是“我如何找到一个表的最后一排”，然后在“如何复制范围”等

你会发现，每一个其中之一之前已经被问过，所以实际上只需要搜索一下Stackoverflow即可。

Sub example() 
    Dim ws As Worksheet, dWs As Worksheet 'variables for ws enumerator and destination ws 
    Dim wb As Workbook 'variable to define the workbook context 
    Dim sRng As Range, dRng As Range 'variables for source range and destination range 

    Set wb = ActiveWorkbook 

    'Add the results sheet and assign our current row range 
    Set dWs = wb.Worksheets.Add 
    Set dRng = dWs.Cells(2, 1) 

    'Change the results sheet name (error if name exists so trap it) 
    On Error Resume Next 
    dWs.Name = "Result" 
    On Error GoTo 0 

    'Loop worksheets 
    For Each ws In wb.Worksheets 

     'Only work on the .csv sheet names 
     If ws.Name Like "*.csv" Then 

      'Find the row with the values on 
      Set sRng = ws.Cells(ws.Rows.Count, 4).End(xlUp) 
      'And set the range to be to the contiguous cells to the right 
      Set sRng = ws.Range(sRng, sRng.End(xlToRight)) 

      'Add the sheet name to the results col A 
      dRng.Value = ws.Name 
      'Copy sRng to the output range 
      sRng.Copy dRng(1, 2) 

      'Increment output row to the next one 
      Set dRng = dRng(2, 1) 

     End If 

    Next ws 

    'Now just add the headers 
    For Each dRng In dWs.Range(dWs.Cells(1, 2), dWs.Cells(1, dWs.Cells.Find("*", , XlFindLookIn.xlFormulas, , XlSearchOrder.xlByColumns, xlPrevious).Column)) 
     dRng.Value = "data " & dRng.Column - 1 
    Next 

End Sub