创build一个循环来将工作表数量的结果行复制到新的工作表中

下午好，

我正在尝试读取csv文件的数量并将其加载到新的工作簿中。 然后创build代码来查找每列最大的数字（即最大值）并粘贴在每列的底部。 在这个论坛的帮助下，我已经完成了计算最大价值和粘贴拉斯特罗的阶段。

现在我正在试图在我创build的新工作表中传输它们，并用我的代码作为结果命名。 有了以前的build议，我已经想出了如何使用下面的示例将特定范围从一列粘贴到另一个工作表：

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

像下面的东西应该这样做。 毫无疑问，你会想调整位数，但总体结构在那里。 我已经评论了每个块在做什么 – 确保你了解每一行。

但通常提出问题，你应该真的把问题分解成几部分。

就像 – “我如何循环纸张”，然后“如何find纸张的最后一行”，然后是“如何复制范围”等

你会发现之前已经询问过每一个，所以实际上只需要search一下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