Нужна помощь в извлечении данных Excel из рабочих книг VBA скрипт

Question

У меня есть две книги Excel

1. WorkBook1 с именем Week1 -> у него есть две таблицы предупреждений и задач
2. WorkBook2 с именем Week2 -> у него две таблицы предупреждений и задач

Пример моего файла Week1

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

Когда рабочая тетрадь il oop - Week1 / Week2 с Рабочим листом с именем Оповещения перед каждой датой, мне нужно добавить строки как

1-Jan-2020 L1 Monitoring

Мне удалось l oop через каждую рабочую книгу и ее рабочие листы.

В настоящее время я смог l oop и объединить данные на одном листе, но не знал, как это сделать. вставляйте вышеуказанную строку перед каждой датой с листа оповещений

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

Пожалуйста, проверьте это. Вам нужно будет добавить дополнительное форматирование (код, имя, что угодно), но давайте сначала убедимся, что это соответствует вашим потребностям.

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