Excel VBA- Append Data Vertically

EXCEL VBA TO COMPILE RANGES

Suppose that we are given some data in a sheet as shown below. There are contiguous blocks of data ranges which begins with the word “Customer”. How can such data ranges be compiled together on a new sheet using VBA? The solution code is given in this example.

	A	B	C	D	E	F
1	MANGO			XYZ		APPLE
2	Customer	64	42	83	82	87
3	59	6	90	42	49	47
4	71	99	12	72	86	52
5	32	3	2	45	62	14
6
7	Customer	45	92	9	96	25
8	94	69	92	34	57	17
9	84	58	28	24	27	88
10
11
12	Customer	76	96	36	95	17
13	12	50	7	28	87	55
14	15	77	82	9	47	3
15	43	45	3	1	18	46
16
17
18	Customer	25	13	21	45	42
19			MAN		ABC
20
21	Customer	74	41	22	97	67
22	67	3	86	53	6	10
23	49	15	92	4	9	82
24	18	93	70	9	98	75
25	36	35	49	53	9	68
26	78	6	2	13	41	78

CODE:

Sub pCustRngCopy()

    Dim rngSearch As Range

    Dim rngFound As Range

    Dim rngDest As Range

    Dim rngCopy As Range

    Dim strFirstAddress As String

   

    Application.ScreenUpdating = False

    On Error GoTo lblError

   

    Set rngSearch = Sheets("Src").Columns("A:A")

    Set rngDest = Sheets("Dest").Range("A1")

   

    Set rngFound = rngSearch.Find(What:="Customer", After:=rngSearch.Range("A1"), LookIn:=xlValues, _

    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

    MatchCase:=False, SearchFormat:=False)

   

    If Not rngFound Is Nothing Then

        strFirstAddress = rngFound.Address

        Sheets("Dest").Cells.ClearContents

        Do

            Set rngCopy = rngFound.CurrentRegion

            rngCopy.Copy rngDest

            Set rngDest = rngDest.Offset(rngCopy.Rows.Count)

            Set rngFound = rngSearch.FindNext(rngFound)

        Loop Until rngFound.Address = strFirstAddress

    End If

    MsgBox "Done.", vbInformation

lblError:

If Err.Number <> 0 Then

    MsgBox "Error Number:" & Err.Number & vbCrLf & "Error Description: " & Err.Number

End If

Application.ScreenUpdating = True

End Sub

OUTPUT:

	A	B	C	D	E	F
1	Customer	64	42	83	82	87
2	59	6	90	42	49	47
3	71	99	12	72	86	52
4	32	3	2	45	62	14
5	Customer	45	92	9	96	25
6	94	69	92	34	57	17
7	84	58	28	24	27	88
8	Customer	76	96	36	95	17
9	12	50	7	28	87	55
10	15	77	82	9	47	3
11	43	45	3	1	18	46
12	Customer	25	13	21	45	42
13	Customer	74	41	22	97	67
14	67	3	86	53	6	10
15	49	15	92	4	9	82
16	18	93	70	9	98	75
17	36	35	49	53	9	68
18	78	6	2	13	41	78