VBA to copy paste data from 'multiple sheets' in a 'Report_Data' workbook into a new 'Master_Data' workbook in single worksheet called Client_Master

[drp92]

Dear All,

I daily get a system generated report in excel file named 'Report_Data.xls' which contains customer/client wise details of each of the client in a separate worksheet with name of customer/client

E.g. File Name : Report_Data.xls -->> this workbook has 250+ sheets, i.e. 1 each for the customer/client.

~Link to sample Report_Data file [~warning:-will immediately download as excel file]

What I could do for the time being is select the all the data from the customers/clients sheets and copy

Sub CopyData()

TotalSheets = Worksheets.Count

For i = 1 To TotalSheets
    If Worksheets(i).Name <> "Overall Summary" And Worksheets(i).Name <> "Consolidated" And Worksheets(i).Name <> "MasterSheet" Then
    
    LastRow = Worksheets(i).Select
        Range("A1:K" & Range("A" & Rows.Count).End(xlUp).Row).Select
    End If
Next

End Sub

What I want to achieve is this : ~Link to End Goal - Master_Data [~warning:-will immediately download as excel file]

Question is -
1. How to copy the selection
3. Create new file called Master_Data
2. How to paste the selection in new file [i.e. Master_Data workbook --> into single 'Client_Master' worksheet] one after the other vertically starting from column C.
3. Create additional helper columns A and B in new file [i.e. Client_Master worksheet] created with values from Report_Data --> individual sheet's A2 and B2 for each of the customer/client sheets.
Note : - Cell values at A2 and B2 in each of the individual customer/client wise sheets in Report_Data will always have name and date respectively.


Short Summary
Input>>Report_Data ----> is System generated report has 250+ worksheets, i.e. 1 each for the client
Output>>Master_Data ----> end goal is create this file/workbook with single worksheet named 'Client_Master' having all the data of 250+ clients one after the other with additional helper column A and B, the values of which will be taken from each of A2 and B2 of individual sheets in Report_Data workbook.

 

[DanteAmor]

Try this:

Option Explicit

Sub CopyData()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim wb1 As Workbook, wb2 As Workbook
  Dim lr1 As Long, lr2 As Long
  
  Application.ScreenUpdating = False
  
  Set wb1 = ThisWorkbook
  Set wb2 = Workbooks.Add(xlWBATWorksheet)
  Set sh2 = wb2.Sheets(1)
  sh2.Name = "Client_Master"
  lr2 = 2
  For Each sh1 In wb1.Sheets
    Select Case sh1.Name
      Case "Overall Summary", "Consolidated", "MasterSheet"
      Case Else
        lr1 = sh1.Range("A" & Rows.Count).End(3).Row
        If lr1 > 1 Then
          sh2.Range("C" & lr2, "D" & lr2).Value = Array("Name Of Client: " & sh1.Name, Date)
          lr2 = lr2 + 2
          sh2.Range("A" & lr2, "B" & lr2).Value = Array("Client Name", "DATE")
          sh2.Range("C" & lr2).Resize(lr1, 11).Value = sh1.Range("A1:K" & lr1).Value
          sh2.Range("A" & lr2 + 1).Resize(lr1 - 1).Value = sh1.Name
          sh2.Range("B" & lr2 + 1).Resize(lr1 - 1).Value = Date
          lr2 = lr2 + lr1 + 1
        End If
    End Select
  Next
  wb2.SaveAs wb1.Path & "\" & "Master_Data"
End Sub

 

[drp92]

Try this:

Option Explicit

Sub CopyData()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim wb1 As Workbook, wb2 As Workbook
  Dim lr1 As Long, lr2 As Long
 
  Application.ScreenUpdating = False
 
  Set wb1 = ThisWorkbook
  Set wb2 = Workbooks.Add(xlWBATWorksheet)
  Set sh2 = wb2.Sheets(1)
  sh2.Name = "Client_Master"
  lr2 = 2
  For Each sh1 In wb1.Sheets
    Select Case sh1.Name
      Case "Overall Summary", "Consolidated", "MasterSheet"
      Case Else
        lr1 = sh1.Range("A" & Rows.Count).End(3).Row
        If lr1 > 1 Then
          sh2.Range("C" & lr2, "D" & lr2).Value = Array("Name Of Client: " & sh1.Name, Date)
          lr2 = lr2 + 2
          sh2.Range("A" & lr2, "B" & lr2).Value = Array("Client Name", "DATE")
          sh2.Range("C" & lr2).Resize(lr1, 11).Value = sh1.Range("A1:K" & lr1).Value
          sh2.Range("A" & lr2 + 1).Resize(lr1 - 1).Value = sh1.Name
          sh2.Range("B" & lr2 + 1).Resize(lr1 - 1).Value = Date
          lr2 = lr2 + lr1 + 1
        End If
    End Select
  Next
  wb2.SaveAs wb1.Path & "\" & "Master_Data"
End Sub

This consolidates the data in the way my end goal is. Thank you so much.

There is small hiccup though that, I had to this for older data as well and want the 'actual date' from the Individual_Report_Data_worksheets instead of the today's date.

 

[Marc L]

What I want to achieve is this

Hi, according to your attachment a VBA demonstration for starters​

assuming the source workbook Report_Data.xlsx is already opened (as guessing can't be coding !) :​

Sub Demo1()
        Dim Wb As Workbook, Ws As Worksheet, L&, R&
        Set Wb = Workbooks("Report_Data.xlsx")
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    With Workbooks.Add(xlWBATWorksheet).ActiveSheet
        .Name = "Client_Master"
    For Each Ws In Wb.Worksheets
        R = L + 1
        Ws.UsedRange.Copy .Cells(R, 3)
    With .Cells(R + 3, 1).Resize(, 2)
         .Font.Bold = True
         .Value2 = [{"Client Name","DATE"}]
    End With
        L = .Cells(.Rows.Count, 3).End(xlUp).Row
       .Cells(R + 1, 3).Resize(, 2).Copy .Range("A" & R + 4 & ":B" & L)
    Next
       .UsedRange.Columns(1).AutoFit
       .Parent.SaveAs Wb.Path & "\Master_Data ", 51
    End With
       .DisplayAlerts = True
       .ScreenUpdating = True
    End With
        Set Wb = Nothing
End Sub

 

[drp92]

Hi, according to your attachment a VBA demonstration for starters​

assuming the source workbook Report_Data.xlsx is already opened (as guessing can't be coding !) :​

Sub Demo1()
        Dim Wb As Workbook, Ws As Worksheet, L&, R&
        Set Wb = Workbooks("Report_Data.xlsx")
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    With Workbooks.Add(xlWBATWorksheet).ActiveSheet
        .Name = "Client_Master"
    For Each Ws In Wb.Worksheets
        R = L + 1
        Ws.UsedRange.Copy .Cells(R, 3)
    With .Cells(R + 3, 1).Resize(, 2)
         .Font.Bold = True
         .Value2 = [{"Client Name","DATE"}]
    End With
        L = .Cells(.Rows.Count, 3).End(xlUp).Row
       .Cells(R + 1, 3).Resize(, 2).Copy .Range("A" & R + 4 & ":B" & L)
    Next
       .UsedRange.Columns(1).AutoFit
       .Parent.SaveAs Wb.Path & "\Master_Data ", 51
    End With
       .DisplayAlerts = True
       .ScreenUpdating = True
    End With
        Set Wb = Nothing
End Sub

Thanks for the response and quick code snippet.
The data getting consolidated in correct manner.

However, there is problem that the cell values in new file Master_Data workbook --> in Client Master worksheet values from [Report_Data] --> A2 (having client name) and B2 (having date when the report is generated) is not being captured in new worksheet against the details for that client

 

[drp92]

This consolidates the data in the way my end goal is. Thank you so much.

There is small hiccup though that, I had to this for older data as well and want the 'actual date' from the Individual_Report_Data_worksheets instead of the today's date.

I got it, changed the line 19 & 24 for code provided by @DanteAmor

instead of
sh2.Range("B" & lr2 + 1).Resize(lr1 - 1).Value = Date
with this
sh2.Range("B" & lr2 + 1).Resize(lr1 - 1).Value = sh1.Range("B2").Value

i.e. changed "Date" at line 19 and 24 with "sh1.Range("B2").Value"

Again @DanteAmor, Thank you so much for providing the gem of code for the given situation.?

To further improve/make it more presentable:-
1. I now will try to strip/delete the data from A6 and above and have header at A7, B7 and C7 which can be utilised for filtering the consolidated data.
2. D7 onward the header are correct but are repeating throughout the file, which also can be stripped?

for now, i can mark this as complete/answered.

 

[Marc L]

However, there is problem that the cell values in new file

As I wrote « according to your attachment » the VBA procedure works as expected on my side so did you try at least with the same attachment ?​

 

[DanteAmor]

Im glad to help you. Thanks for the feedback

 

[drp92]

As I wrote « according to your attachment » the VBA procedure works as expected on my side so did you try at least with the same attachment ?​

Sorry for this, just now i tried and it works for the the attached files, so this is also works.
Again sorry for not trying earlier.

So this is also a solution.