Sheets Data to be Displayed in a Worksheet

arijitirf

Board Regular
Joined
Aug 11, 2016
Messages
118
Office Version
  1. 2016
Platform
  1. Windows
Hello!!
I have a workbook having more than 1700 sheets (Starts as Stock Code 1, Stock Code 2 ...) in which data starts from Column A8. I want to copy A8 to D (last row of Column D) to a new sheet with sheet name. In same way it will also display Column F9 to I (last row of Column I) and data will be looking like

[TABLE="width: 771"]
<colgroup><col><col><col><col><col><col><col><col><col span="3"></colgroup><tbody>[TR]
[TD]Sheet Name[/TD]
[TD]Date[/TD]
[TD]MIGO[/TD]
[TD]Unit[/TD]
[TD]Qty.[/TD]
[TD] [/TD]
[TD]Sheet Name[/TD]
[TD]Issue Date[/TD]
[TD]Req. No.[/TD]
[TD]Unit[/TD]
[TD]Qty.[/TD]
[/TR]
[TR]
[TD]Stock Code 1[/TD]
[TD]24-11-2014[/TD]
[TD]5001040239[/TD]
[TD]No.[/TD]
[TD]2[/TD]
[TD] [/TD]
[TD]Stock Code 1[/TD]
[TD]26-12-2015[/TD]
[TD]96[/TD]
[TD]No.[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Stock Code 1[/TD]
[TD]05-03-2016[/TD]
[TD]5001543431[/TD]
[TD]No.[/TD]
[TD]1[/TD]
[TD] [/TD]
[TD]Stock Code 2[/TD]
[TD]26-12-2015[/TD]
[TD]97[/TD]
[TD]No.[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]Stock Code 2[/TD]
[TD]26-11-2014[/TD]
[TD]5001042671[/TD]
[TD]No.[/TD]
[TD]6[/TD]
[TD] [/TD]
[TD]Stock Code 2[/TD]
[TD]02-01-2019[/TD]
[TD]GEN-20[/TD]
[TD]No.[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Stock Code 2[/TD]
[TD]19-04-2016[/TD]
[TD]5001591782[/TD]
[TD]No.[/TD]
[TD]3[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]08-12-2015[/TD]
[TD]79[/TD]
[TD]No.[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Stock Code 2[/TD]
[TD]22-01-2019[/TD]
[TD]5002736188[/TD]
[TD]No.[/TD]
[TD]1578[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]26-12-2018[/TD]
[TD]EL-109[/TD]
[TD]No.[/TD]
[TD]52[/TD]
[/TR]
[TR]
[TD]Stock Code 3[/TD]
[TD]18-12-2014[/TD]
[TD]5001067389[/TD]
[TD]No.[/TD]
[TD]3[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]18-01-2019[/TD]
[TD]EL-145[/TD]
[TD]No.[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]Stock Code 3[/TD]
[TD]12-03-2016[/TD]
[TD]5001551257[/TD]
[TD]No.[/TD]
[TD]2[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]21-01-2019[/TD]
[TD]EL-146[/TD]
[TD]No.[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Stock Code 3[/TD]
[TD]15-12-2018[/TD]
[TD]5002688227[/TD]
[TD]No.[/TD]
[TD]418[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]04-02-2019[/TD]
[TD]EL-162[/TD]
[TD]No.[/TD]
[TD]124[/TD]
[/TR]
[TR]
[TD]Stock Code 3[/TD]
[TD]15-12-2018[/TD]
[TD]5002688227[/TD]
[TD]No.[/TD]
[TD]218[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]04-02-2019[/TD]
[TD]EL-163[/TD]
[TD]No.[/TD]
[TD]22[/TD]
[/TR]
[TR]
[TD]Stock Code 4[/TD]
[TD]18-12-2014[/TD]
[TD]5001067427[/TD]
[TD]No.[/TD]
[TD]2[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]20-02-2019[/TD]
[TD]EL-203[/TD]
[TD]No.[/TD]
[TD]18[/TD]
[/TR]
[TR]
[TD]Stock Code 4[/TD]
[TD]12-03-2016[/TD]
[TD]5001551258[/TD]
[TD]No.[/TD]
[TD]1[/TD]
[TD] [/TD]
[TD]Stock Code 3[/TD]
[TD]22-02-2019[/TD]
[TD]EL-206[/TD]
[TD]No.[/TD]
[TD]58[/TD]
[/TR]
[TR]
[TD]Stock Code 4[/TD]
[TD]08-01-2019[/TD]
[TD]5002720336[/TD]
[TD]No.[/TD]
[TD]459[/TD]
[TD] [/TD]
[TD]Stock Code 4[/TD]
[TD]26-12-2015[/TD]
[TD]96[/TD]
[TD]No.[/TD]
[TD]2
[/TD]
[/TR]
</tbody>[/TABLE]

here is the link of my workbook

https://www.dropbox.com/s/9ynx9bhjgxbemxx/abc.xlsx?dl=0

Thanks in advance..
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Code:
Sub t()
Dim sh As Worksheet, rng1 As Range, rng2 As Range, cnt1 As Long, cnt2 As Long
    For Each sh In ThisWorkbook.Sheets
        Sheets.Add After:=Sheets(Sheets.Count)
        If sh.Name Like "Stock Code*" Then
            Set rng1 = sh.Range("A8", sh.Cells(Rows.Count, 1).End(xlUp)).Resize(, 4)
            Set rng2 = sh.Range("F9", sh.Cells(Rows.Count, "F").End(xlUp)).Resize(, 7)
            cnt1 = rng1.Rows.Count
            cnt2 = rng2.Rows.Count
            rng1.Copy ActiveSheet.Range("B2")
            ActiveSheet.Range("A2").Resize(cnt1) = sh.Name
            rng2.Copy ActiveSheet.Cells(Rows.Count, 2).End(xlUp)(2)
            ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2).Resize(cnt2) = sh.Name
        End If
    Next
End Sub
 
Upvote 0
Thanks for your prompt reply. Your code is pulling sheet data in different sheets (need to pull data from different sheets to a single sheet namely "Master"). Also it couldn't manage to pull last row data.

Please extend your support and oblige.
 
Upvote 0
Thanks for your prompt reply. Your code is pulling sheet data in different sheets (need to pull data from different sheets to a single sheet namely "Master"). Also it couldn't manage to pull last row data.

Please extend your support and oblige.

I want to copy A8 to D (last row of Column D) to a new sheet with sheet name.
Two things, your data range description in the OP does not match the data ranges of the sheets in the link provided. Secondly, The quote from the OP in red fornt above indicates the need for a new sheet for each copy action. What you need to do is state your objective clearly, using the range parameters of your actual files (starting row/column) and the number of workbooks involved (There is no "Master" sheet in the file in the link above) and if they are not in the same folder, provide the paths for the one that does not contain the "Master" sheet. Then I can get the code modified to do what you want.
 
Last edited:
Upvote 0
This assumes that sheet 'Master' is in the same workbook as the 'Stock Code' sheets and that data begins on row 10 as in the sheets in the linked file.

Code:
Sub t()
Dim sh As Worksheet, rng1 As Range, rng2 As Range, cnt1 As Long, cnt2 As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "Stock Code*" Then
            Set rng1 = sh.Range("A10", sh.Cells(Rows.Count, 4).End(xlUp))
            Set rng2 = sh.Range("F10", sh.Cells(Rows.Count, "K").End(xlUp))
            cnt1 = rng1.Rows.Count
            cnt2 = rng2.Rows.Count
            rng1.Copy Sheets("Master").Range("B2")
            Sheets("Master").Range("A2").Resize(cnt1) = sh.Name
            rng2.Copy Sheets("Master").Cells(Rows.Count, 2).End(xlUp)(2)
            Sheets("Master").Cells(Rows.Count, 1).End(xlUp)(2).Resize(cnt2) = sh.Name
        End If
    Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top