繁体   English   中英

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

[英]Importing Data from specific excel sheets from multiple workbooks in a folder

我需要将多个 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。任何帮助都会很棒!

您只需要一个 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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM