从文件夹中的多个工作簿中的特定 Excel 工作表导入数据答案

【问题标题】：Importing Data from specific excel sheets from multiple workbooks in a folder从文件夹中的多个工作簿中的特定 Excel 工作表导入数据
【发布时间】：2018-10-31 04:20:19
【问题描述】：

我需要将多个 Excel 工作簿中特定工作表中的数据提取到主副本中。我已经设法制作了一个从工作簿中的每张纸中提取但无法弄清楚如何让它从指定的表格中提取数据的方法。我的代码如下：

    Sub getDataFromWbs()

    Dim wb As Workbook, ws As Worksheet
    Set fso = CreateObject("Scripting.FileSystemObject")

    'This is where you put YOUR folder name
    Set fldr = fso.GetFolder("C:\Users\Matthew.Stokes.Hughe\Desktop\test 2\Temp\")

    'Next available Row on Master Workbook
    y = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1

    'Loop through each file in that folder
    For Each wbFile In fldr.Files

        'Make sure looping only through files ending in .xlsx (Excel files)
        If fso.GetExtensionName(wbFile.Name) = "xlsx" Then

          'Open current book
          Set wb = Workbooks.Open(wbFile.Path)

          'Loop through each sheet (ws)
          For Each ws In wb.Sheets

          'Last row in that sheet (ws)
              wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row

              'Loop through each record (row 2 through last row)
              For x = 2 To wsLR
                'Put column 1,2,3 and 4 of current sheet (ws) into row y of master sheet, then increase row y to next row
                ThisWorkbook.Sheets("sheet1").Cells(y, 1) = ws.Cells(x, 1) 'col 1
                ThisWorkbook.Sheets("sheet1").Cells(y, 2) = ws.Cells(x, 2) 'col 1
                ThisWorkbook.Sheets("sheet1").Cells(y, 3) = ws.Cells(x, 3) 'col 1
                ThisWorkbook.Sheets("sheet1").Cells(y, 4) = ws.Cells(x, 4) 'col 1
                y = y + 1
              Next x

            Next ws

          'Close current book
          wb.Close
        End If

    Next wbFile

    End Sub

要从中提取信息的指定工作表的名称是工作表 1。任何帮助都会很棒！

【问题讨论】：

发生了什么？您的代码表面上看起来还不错。您是否在 Sheet1 工作簿中获取任何数据？
我从源工作簿中的每张工作表中获取数据，而我只想从其中一张工作表（数据）中获取数据。我不知道如何指定只从那一张纸中提取。
我发布了一个答案。您只需要在名称匹配时运行代码。请务必接受答案。欢迎来到 SO。
我看到您将所需工作表的名称从“DATA”更改为“Sheet 1”。这在答案中无关紧要，只需为if WS.Name = "Sheet 1" Then 调整我的代码即可。祝你好运。
感谢大家的帮助，最后一件事，无论如何要缩短 ThisWorkbook.Sheets("sheet1").Cells(y, 1) = ws.Cells(x, 1) 'col 1 行，因为我刚刚意识到我需要提取 69 个不同的数据点

标签： excel vba

【解决方案1】：

您只需要一个 if 语句来检查名称：

Sub getDataFromWbs()

  Dim wb As Workbook, ws As Worksheet
  Set fso = CreateObject("Scripting.FileSystemObject")

  'This is where you put YOUR folder name
  Set fldr = fso.GetFolder("C:\Users\Matthew.Stokes.Hughe\Desktop\test 2\Temp\")

  'Next available Row on Master Workbook
  y = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1

  'Loop through each file in that folder
  For Each wbFile In fldr.Files

      'Make sure looping only through files ending in .xlsx (Excel files)
      If fso.GetExtensionName(wbFile.Name) = "xlsx" Then

        'Open current book
        Set wb = Workbooks.Open(wbFile.Path)

        'Loop through each sheet (ws)
        For Each ws In wb.Sheets
  
          'check WS name
          If UCase(ws.Name) = "DATA" Then
  
        'Last row in that sheet (ws)
            wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row

            'Loop through each record (row 2 through last row)
            For x = 2 To wsLR
            
              Dim c As Long
              For c = 1 To 4
              'Put column 1,2,3 and 4 of current sheet (ws) into row y of master sheet, then increase row y to next row
                  ThisWorkbook.Sheets("sheet1").Cells(y, c) = ws.Cells(x, c) 'col 1
              Next c
              
              y = y + 1
            Next x
          
          End If
          Next ws

        'Close current book
        wb.Close
      End If

  Next wbFile

  End Sub

【讨论】：