combining 1000 separated ranges from multiple sheets into one

[Alaa mg]

Hello

I have about 1000 separated range in each sheet , and each range could contain at least 15 rows so the final rows are about 15000 rows .

every sheet contains name so when put the ranges under each other should create name for each range based on sheet name

the result in COMBINED sheet and will add new sheet before COMBINED sheet every time so should delete data in COMBINED sheet when copy data every time

insert.xlsm
	A	B	C	D	E
1	DATE	Describe	DEBIT	CREDIT	BALANCE
2	05/01/2022	NOT PAID	1233		1233
3	06/01/2022	NOT PAID	1233		2466
4	07/01/2022	PAID		2000	466
5	08/01/2022	PAID		466	0
ALA

insert.xlsm
	A	B	C	D	E
1	DATE	Describe	DEBIT	CREDIT	BALANCE
2	08/01/2022				0
3	09/01/2022	NOT PAID	2000		2000
4	11/01/2022	NOT PAID	2000	1000	3000
5	11/01/2022	NOT PAID	2000	5000	0
MAL

insert.xlsm
	A	B	C	D	E
1	DATE	Describe	DEBIT	CREDIT	BALANCE
2	11/01/2022				0
3	12/01/2022	NOT PAID	1500		1500
4	13/01/2022	NOT PAID	500		2000
5	14/01/2022	PAID	2000	1000	3000
6	15/01/2022	PAID		1010	1990
7	16/01/2022	PAID		1000	990
8	17/01/2022	PAID		990	0
MOUNIRR

I expect like this

insert.xlsm
	A	B	C	D	E
1			NAME
2			ALA
3	DATE	Describe	DEBIT	CREDIT	BALANCE
4	05/01/2022	NOT PAID	1233		1233
5	06/01/2022	NOT PAID	1233		2466
6	07/01/2022	PAID		2000	466
7	08/01/2022	PAID		466	0
8
9
10			NAME
11			MAL
12	DATE	Describe	DEBIT	CREDIT	BALANCE
13	08/01/2022				0
14	09/01/2022	NOT PAID	2000		2000
15	11/01/2022	NOT PAID	2000	1000	3000
16	11/01/2022	NOT PAID	2000	5000	0
17
18
19			NAME
20			MOUNIRR
21	DATE	Describe	DEBIT	CREDIT	BALANCE
22	11/01/2022				0
23	12/01/2022	NOT PAID	1500		1500
24	13/01/2022	NOT PAID	500		2000
25	14/01/2022	PAID	2000	1000	3000
26	15/01/2022	PAID		1010	1990
27	16/01/2022	PAID		1000	990
28	17/01/2022	PAID		990	0
COMBINED

thanks.

 

[igold]

I am not sure what you want done with this part

and will add new sheet before COMBINED sheet every time so should delete data in COMBINED sheet when copy data every time

But this should at least get you half way there...

Sub getRanges()

    Dim ws As Worksheet
    Dim wsC As Worksheet: Set wsC = Worksheets("COMBINED")
    Dim lRow As Long, adr As Long
    
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        If Not ws.Name = wsC.Name Then
            lRow = Cells(Rows.Count, 1).End(xlUp).Row + adr
            With wsC.Cells(lRow, 3)
                .Value = "NAME"
                .Interior.Color = RGB(156, 193, 227)
            End With
            wsC.Cells(lRow + 1, 3) = ws.Name
            ws.UsedRange.Copy wsC.Cells(lRow + 2, 1)
        End If
        adr = 3
    Next ws
    Application.ScreenUpdating = True

End Sub

 

[Alaa mg]

I am not sure what you want done with this part

to avoid repeating to copying data have already copied to the bottom ,your code does it . should not do that.

 

[igold]

Are you saying that the provided code satisfies your requirement as posted or do you need additional help...

 

[Alaa mg]

not really .
first your code need fixing as explained in post #3
second the code seems to work greatly with simple data .
third I have to test it with big data at work tomorrow to see how goes.

 

[igold]

Ok, can you explain what needs to be fixed. Do you want the sheets deleted after they are copied or do you want the current information on the copied sheets deleted. If you can explain exactly what you want done, we can alter the code.

 

[Alaa mg]

just delete data in combined sheet after they are copied
in other meaning delete data have already copied before copied data again when run the macro every time
this calls replace data.

Do you want the sheets deleted after they are copied or do you want the current information on the copied sheets deleted.

Neither

 

[igold]

Is this what you want. Please test on a backup copy of your data as this code will delete data which is not easily recoverable...

Sub getRanges()

    Dim ws As Worksheet
    Dim wsC As Worksheet: Set wsC = Worksheets("COMBINED")
    Dim lRow As Long, adr As Long
    
    Application.ScreenUpdating = False
    With wsC
        .Cells.Clear
        .Activate
    End With
    For Each ws In ActiveWorkbook.Worksheets
        If Not ws.Name = wsC.Name Then
            lRow = Cells(Rows.Count, 1).End(xlUp).Row + adr
            With wsC.Cells(lRow, 3)
                .Value = "NAME"
                .Interior.Color = RGB(156, 193, 227)
            End With
            wsC.Cells(lRow + 1, 3) = ws.Name
            ws.UsedRange.Copy wsC.Cells(lRow + 2, 1)
        End If
        adr = 3
    Next ws
    Application.ScreenUpdating = True

End Sub

 

[Alaa mg]

yes this what I want it .
well , your code is really efficient and fast with simple data but I will inform you tomorrow if I need help you .
thank you .

 

[igold]

Ok, I only have the simple data that you provided. To be honest, if this code is used on a large amount of data it will slow down drastically. The reason being is that the code is going back & forth to the worksheets (copying & pasting) in the middle of the loop. That is a very inefficient method of coding and will slow the code down.
That said, without seeing your real data, it is hard to know how the code can be written to accommodate your true data.