循环浏览许多工作簿，仅循环浏览第一个和第二个工作表，然后将单元格复制/粘贴到工作簿中答案

【问题标题】：Loop through many workbooks, loop through only the first and second worksheets, then copy/paste cells into a workbook循环浏览许多工作簿，仅循环浏览第一个和第二个工作表，然后将单元格复制/粘贴到工作簿中
【发布时间】：2018-01-04 20:58:51
【问题描述】：

“新的 VBA 用户，Excel 2010，我在同一个文件夹中有几个成本估算工作簿。在一个单独的摘要工作簿中，我想循环浏览所有工作簿，然后只循环浏览第一个和第二个工作表，然后复制并最终粘贴特定单元格的值。

我从以下几个来源拼凑了某些 sn-ps。目前只有工作表“Distro Sheet”的第一个“If”循环似乎正在获取数据。 “执行估计”的第二个“If”循环似乎从不粘贴任何单元格？我尝试标记前两个工作表，使用数组，并使用“Case”语句。这些方法都不起作用。任何想法将不胜感激！”

Sub GatherData()

Dim wkbkorigin As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet

Dim ResultRow As Long
Dim Fname As String
Dim RngDest As Range
Dim ws As Worksheet

Set destsheet = ThisWorkbook.Worksheets("Project Cost Tracker")
Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).EntireRow
Fname = Dir(ThisWorkbook.Path & "/*.xlsx")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While Fname <> "" And Fname <> ThisWorkbook.Name
 Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)

        For Each ws In wkbkorigin.Worksheets

                    If ws.Name = "Distro Sheet" Then

                        RngDest.Cells(6, 1).Value = ws.Range("C8").Value
                        RngDest.Cells(6, 5).Value = ws.Range("H8").Value
                        RngDest.Cells(5, 2).Value = ws.Range("C10").Value
                        RngDest.Cells(7, 1).Value = ws.Range("C15").Value
                        RngDest.Cells(8, 1).Value = ws.Range("C16").Value
                        RngDest.Cells(9, 1).Value = ws.Range("C17").Value
                        RngDest.Cells(10, 1).Value = ws.Range("C18").Value
                        RngDest.Cells(11, 1).Value = ws.Range("C19").Value
                        RngDest.Cells(7, 5).Value = ws.Range("D20").Value
                        RngDest.Cells(8, 5).Value = ws.Range("D21").Value
                        RngDest.Cells(9, 5).Value = ws.Range("D22").Value
                        RngDest.Cells(10, 5).Value = ws.Range("D23").Value
                        RngDest.Cells(11, 5).Value = ws.Range("D24").Value

                    End If

                    If ws.Name = "Execution Estimate" Then

                        RngDest.Cells(8, 10).Value = ws.Range("J99").Value
                        RngDest.Cells(9, 10).Value = ws.Range("J157").Value
                        RngDest.Cells(10, 10).Value = ws.Range("J186").Value

                    End If

         Set RngDest = RngDest.Offset(1, 0)

       Next ws

 wkbkorigin.Close SaveChanges:=False
 Fname = Dir()

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

【问题讨论】：

您是否尝试过使用调试器逐行执行？
@SandPiper 是的，变量 ws 按应有的方式遍历每个工作表，但在工作表 #2“执行估计”上，没有任何值填充我的摘要工作簿。似乎有更好的方法来单步执行选定的工作表而不是全部？感谢您的反馈！
当您到达第二张表时，ws.Name 的值是多少？是"Execution Estimate"（大小写精确，没有多余的空格，拼写精确）？（即，当您单步执行代码时，它是否真的进入第二个If 语句？）
我现在看到，在评估“执行估计”的 If 语句时没有评估。它简单地跳过。我正在运行多个示例工作簿，它们每个都有第二个工作表准确地拼出“执行估计”。我也试过“执行*”没有成功。
你们俩都很棒@SandPiper 和@YowE3K！ “执行估计”在末尾有一个额外的空间。代码在家中在 Excel 2016 中完美运行。谢谢，周末愉快！更正的代码如下..

标签： excel excel-2010 vba

【解决方案1】：

这是更正后的代码.. 以及使用调试器和跟踪重要变量的经验教训。

    Sub GatherData()

         Dim wkbkorigin As Workbook
         Dim originsheet As Worksheet
         Dim destsheet As Worksheet

         Dim ResultRow As Long
         Dim Fname As String
         Dim RngDest As Range
         Dim ws As Worksheet

         Set destsheet = ThisWorkbook.Worksheets("Project Cost Tracker")
         Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).EntireRow
         Fname = Dir(ThisWorkbook.Path & "/*.xlsx")

         Application.ScreenUpdating = False
         Application.DisplayAlerts = False

         Do While Fname <> "" And Fname <> ThisWorkbook.Name
         Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)

         For Each ws In wkbkorigin.Worksheets

                    If ws.Name = "Distro Sheet" Then

                        RngDest.Cells(6, 1).Value = ws.Range("C8").Value
                        RngDest.Cells(6, 5).Value = ws.Range("H8").Value
                        RngDest.Cells(5, 2).Value = ws.Range("C10").Value
                        RngDest.Cells(7, 1).Value = ws.Range("C15").Value
                        RngDest.Cells(8, 1).Value = ws.Range("C16").Value
                        RngDest.Cells(9, 1).Value = ws.Range("C17").Value
                        RngDest.Cells(10, 1).Value = ws.Range("C18").Value
                        RngDest.Cells(11, 1).Value = ws.Range("C19").Value
                        RngDest.Cells(7, 5).Value = ws.Range("D20").Value
                        RngDest.Cells(8, 5).Value = ws.Range("D21").Value
                        RngDest.Cells(9, 5).Value = ws.Range("D22").Value
                        RngDest.Cells(10, 5).Value = ws.Range("D23").Value
                        RngDest.Cells(11, 5).Value = ws.Range("D24").Value

                    End If

                    If ws.Name = "Execution Estimate " Then

                        RngDest.Cells(8, 10).Value = ws.Range("J99").Value
                        RngDest.Cells(9, 10).Value = ws.Range("J157").Value
                        RngDest.Cells(10, 10).Value = ws.Range("J186").Value

                    End If

         Set RngDest = RngDest.Offset(1, 0)

       Next ws

    wkbkorigin.Close SaveChanges:=False
   Fname = Dir()

   Loop

   Application.ScreenUpdating = True
   Application.DisplayAlerts = True

   End Sub

【讨论】：

【解决方案2】：

所以，只有第一张和第二张，对吧？

wks.Index = 1
wks.Index = 2

代码应该看起来像这样。 . .

objXL.Visible = True
Set wkb = objXL.Workbooks.Open(strPathFile)
For Each wks In wkb.Worksheets
    If wks.Index = 1 or wks.Index = 2 Then
        NeedThisSheet = wks.Name & "!"
        ' THIS IS FOR IMPORTING DATA INTO ACCESS
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames, NeedThisSheet
    End If
Next
wkb.Close

【讨论】：