从多张纸中找出细胞总数的过程

我有大约100个文本文件，我导入到Excel（使用2010年）。 每张纸在第一栏中都有我需要的值; 值的行不尽相同，尽pipe它是所有情况下的最后一行。

因为我想不出一个体面的方法来编写一个方法来总结这些值，而没有本质上的“复制”数据，我想我有一个过程，我想去，需要纠正/帮助，如果这是不正确的。

我想find第一列（我的范围）的最后一行，并将其放在一个新的工作表，创build一个列表; 这将在新的页面B列。 列A必须说明数据从中被拉出的表的标题。

我将在这一点上总结价值。

到目前为止，我什么都没有。 我尝试编码以下似乎给我zilch：

Sub Scuba() Dim ws As worksheet Dim rng As Object Dim numrows As Integer numrows = Rows.Count Set rng = .Range(.Cells(1, 9), .Cells(numrows, 9)) worksheet.Add.Name = Tally For Each ws In Workbook Sheets("Tally").Range(xlEnd.Row + 1, 1).Value = ActiveSheet.Name Sheets("Tally").Range(xlEnd.Row + 1, 2).Value = rng.xlEnd Next End Sub 

所有的数据格式如下：

 20141103-20141107 Date In Out Listing 1103 0710 1710 1000 - 1000 1104 0715 1800 1045 - 2045 1105 0715 1800 1045 - 3130 1106 0700 1745 1045 - 4215 1107 0700 1015 0315 - 4530 

划定的空间表示新的单元格。 在这个例子中，我想保留的价值将是4530的最终清单。

任何帮助，将不胜感激。

---

编辑：

由于我在select列中的最后一个单元格时遇到问题，也许我可以将每个表单的最后一行以列表forms排列到新表单上。 这至less可以使整个项目的pipe理变得更容易（每个人的文本文件数量是不一样的，因为他们已经把多less工作放到了时间logging程序中;我将这样做是为了让多个人能够将工作时间X持续时间）。
我仍然希望在A列中有从最后一行开始复制的表格。

随着这个进展，我会发布更多。 感谢所有迄今为止的input。

Answer 1

此代码将创build一个新的工作表“Tally”（除非它已经存在），并添加每个工作表名称和最后小时数的行。 我已经testing了下面的成功。

编辑：这个代码是testing工作

  Sub Scuba() Dim ws As Worksheet Dim RunSub As Long Dim LastRow As Long Dim NameTest As String Dim NewWS As Worksheet On Error Resume Next 'Creates Tally sheet if it doesn't exist NameTest = Worksheets("Tally").Name If Err.Number = 0 Then Else Err.Clear Set NewWS = ActiveWorkbook.Sheets.Add(Before:=ActiveWorkbook.Sheets(1)) NewWS.Name = "Tally" End If For Each ws In ActiveWorkbook.Worksheets If Not ws.Name = "Tally" Then LastRow = ws.Range("I" & Rows.Count).End(xlUp).Row DestRow = Sheets("Tally").Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets("Tally").Range("A" & DestRow).Value = ws.Name Sheets("Tally").Range("B" & DestRow).Value = ws.Range("I" & LastRow).Value Else End If Next ws DestRow = Sheets("Tally").Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets("Tally").Range("A" & DestRow).Value = "Grand Total" Sheets("Tally").Range("B" & DestRow).Value = Application.Sum(Range("B1:B" & DestRow - 1)) MsgBox "Done" End Sub 

Answer 2

我希望这有帮助。

 Sub Scuba() Dim ws As Worksheet, wsTally As Worksheet Dim rng As Object Dim numrows As Integer Set wsTally = Worksheets.Add 'if there is already a sheet named Tally, then this will result in wsTally being called Sheet6 or whatever... On Error Resume Next wsTally.Name = "Tally" On Error GoTo 0 Dim i As Long i = 1 With wsTally For Each ws In ActiveWorkbook i = i + 1 .Range(i + 1, 1).value = ws.Name .Range(i + 1, 2).value = LastValInRow(9, ws).value Next ws End With End Sub Function LastValInRow(Column As Long, WrkSht As Worksheet) As Range Dim c As Range Set c = WrkSht.Columns(Column) 'get the last cell excel thinks is uesd Dim LstUsed As Long LstUsed = c.Rows.Count + 1 'add one, just in case excel is correct 'get the actual last used cell Dim r As Range ' .End(xlUp) is equivalent to Ctrl+Up Set r = c.Cells(LstUsed, 1).End(xlUp) Set LastValInRow = r End Function