Need help in pulling the excel data from work books VBA script

Question

I have two Excel workbooks

WorkBook1 named as Week1 -> it has two worksheets Alerts & Tasks
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

Mech Mech · Accepted Answer · 2020-03-02T18:36:58

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

Need help in pulling the excel data from work books VBA script

1 Answers