Question

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

我已将以下几个来源的某些片段拼凑在一起。目前只有工作表“Distro Sheet”的第一个“If”循环似乎正在抓取数据。 “Execution Estimate”的第二个“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

Answer 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

Answer 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

遍历许多工作簿，仅遍历第一个和第二个工作表，然后将单元格复制/粘贴到工作簿中

2 个答案: