需要帮助从工作簿 VBA 脚本中提取 excel 数据

Question

I have two Excel workbooks

1. WorkBook1 named as Week1 -> it has two worksheets Alerts & Tasks
2. WorkBook2 named as Week2 -> it has two worksheets Alerts & Tasks

Example of my Week1 file

1-Jan-2020 Alert-name    Description
1-Jan-2020 Alert-name    Description
2-Jan-2020 Alert-name    Description
2-Jan-2020 Alert-name    Description

When i loop through Week1/Week2 workbook with Worksheet named Alerts before every date i need to add the lines as

1-Jan-2020 L1 Monitoring

I was able to loop through each work book and its worksheets.

Currently i was able to loop and consolidate the data to a single sheet, but not sure how to insert the above line before every date from the Alerts sheet

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\Radha\Downloads\Temp\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) = CDate(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

Answer 1

Please test this. You will have to add the additional formatting (code, name, whatever else you want) but let's make sure this meets your needs first.

Sub test()
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\Radha\Downloads\Temp\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
          If ws.Name = "Alerts" Then
            '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) = Format(Now(), "DD-MMM-YYYY") '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) = CDate(ws.Cells(x, 4)) 'col 1
            ThisWorkbook.Sheets("sheet1").Cells(y, 5) = ws.Cells(x, 5) 'col 1
            y = y + 1
          Else
            '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) = CDate(ws.Cells(x, 3)) 'col 1
            ThisWorkbook.Sheets("sheet1").Cells(y, 4) = ws.Cells(x, 4) 'col 1
            y = y + 1
          End If
          Next x


      Next ws

      'Close current book
      wb.Close
    End If

Next wbFile

End Sub