Joining data from 4 tabs in a workbook

[paxodiva]

Hello All

Hope someone can help me with a problem i have.

There are 4 data tabs in my excel workbook and i would like to have the ability to amalgamate all the data into 1 sheet by running a macro
as there may be times when i will have added lines to the bottom of one of the sheets.

Could someone please tell me what the easiest way to do this

all help would be much appreciated
Diva

 

[VoG]

This should help you http://msdn.microsoft.com/en-us/library/cc793964.aspx

 

[paxodiva]

thank you for this
I dont appear to be able to get this to work using the document
I am only getting the first line into the overall summary sheet from each work sheet

do i need to change anything to pick up all the data in each sheet

 

[VoG]

Try making the change shown in red

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh)

            ' Specify the range to place the data.
            'Set CopyRng = sh.Range("A1:G1")
            Set CopyRng = sh.UsedRange

            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                GoTo ExitTheSub
            End If

            ' This statement copies values and formats from each
            ' worksheet.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            ' Optional: This statement will copy the sheet
            ' name in the H column.
            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[paxodiva]

thank you very very much that works great
I have 1 last question that i hope you can help me with

I have 2 column in a file as per below

<TABLE style="WIDTH: 228pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=304 x:str><COLGROUP><COL style="WIDTH: 114pt; mso-width-source: userset; mso-width-alt: 5558" span=2 width=152><TBODY><TR style="HEIGHT: 18pt; mso-height-source: userset" height=24><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: olive 1pt solid; BACKGROUND-COLOR: #ffffcc; WIDTH: 114pt; HEIGHT: 18pt; BORDER-TOP: #ffcc99 1.5pt solid; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl24 height=24 width=152>BG-1-1-547225027-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 114pt; BORDER-TOP: #ffcc99 1.5pt solid; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl22 width=152>BG-1-1-547225117-1-1</TD></TR><TR style="HEIGHT: 18pt; mso-height-source: userset" height=24><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: olive 1pt solid; BACKGROUND-COLOR: #ffcc99; WIDTH: 114pt; HEIGHT: 18pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl25 height=24 width=152>ES-1-1-2014116327-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffcc99; WIDTH: 114pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl23 width=152>ES-1-1-2014116770-1-1</TD></TR><TR style="HEIGHT: 18pt; mso-height-source: userset" height=24><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: olive 1pt solid; BACKGROUND-COLOR: #ffffcc; WIDTH: 114pt; HEIGHT: 18pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl24 height=24 width=152>FR-1-1-3064732704-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 114pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl22 width=152>FR-1-1-3064733503-1-1</TD></TR><TR style="HEIGHT: 18pt; mso-height-source: userset" height=24><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: olive 1pt solid; BACKGROUND-COLOR: #ffffcc; WIDTH: 114pt; HEIGHT: 18pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl24 height=24 width=152>FR-1-1-3091242276-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 114pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl22 width=152>FR-1-1-3091265275-1-1</TD></TR></TBODY></TABLE>
What i need now is to remove the BG-1-1- etc from the beginning of each line
your help would me very much appreciated

 

[VoG]

Try this

Sub Atest()
Dim LR As Long, c As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Range("A1:B" & LR)
    With c
        .Value = Right(.Value, Len(.Value) - 7)
    End With
Next c
End Sub

 

[paxodiva]

thats fantastic what you have done
i have had a small misunderstanding of what i need
If you could help me on this 1 last time that would be absolutely fantastic

<TABLE style="WIDTH: 414pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=552 x:str><COLGROUP><COL style="WIDTH: 130pt; mso-width-source: userset; mso-width-alt: 6326" width=173><COL style="WIDTH: 140pt; mso-width-source: userset; mso-width-alt: 6838" width=187><COL style="WIDTH: 48pt" span=3 width=64><TBODY><TR style="HEIGHT: 35.25pt" height=47><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: olive 1pt solid; BACKGROUND-COLOR: #ffffcc; WIDTH: 130pt; HEIGHT: 35.25pt; BORDER-TOP: #ffcc99 1.5pt solid; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl26 height=47 width=173>BG-1-1-547225027-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 140pt; BORDER-TOP: #ffcc99 1.5pt solid; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl27 width=187>BG-1-1-547225117-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 48pt; BORDER-TOP: #ffcc99 1.5pt solid; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl27 width=64>First Commitment Period</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 48pt; BORDER-TOP: #ffcc99 1.5pt solid; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl27 width=64>EUA_AAU</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 48pt; BORDER-TOP: #ffcc99 1.5pt solid; BORDER-RIGHT: olive 1pt solid" class=xl28 width=64 x:num>91</TD></TR><TR style="HEIGHT: 35.25pt" height=47><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: olive 1pt solid; BACKGROUND-COLOR: #ffcc99; WIDTH: 130pt; HEIGHT: 35.25pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl29 height=47 width=173>ES-1-1-2014116327-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffcc99; WIDTH: 140pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl30 width=187>ES-1-1-2014116770-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffcc99; WIDTH: 48pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl30 width=64>First Commitment Period</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffcc99; WIDTH: 48pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl30 width=64>EUA_AAU</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffcc99; WIDTH: 48pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: olive 1pt solid" class=xl31 width=64 x:num>444</TD></TR><TR style="HEIGHT: 35.25pt" height=47><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: olive 1pt solid; BACKGROUND-COLOR: #ffffcc; WIDTH: 130pt; HEIGHT: 35.25pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl26 height=47 width=173>FR-1-1-3064732704-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 140pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl27 width=187>FR-1-1-3064733503-1-1</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 48pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl27 width=64>First Commitment Period</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 48pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: #ffcc99 1.5pt solid" class=xl27 width=64>EUA_AAU</TD><TD style="BORDER-BOTTOM: #ffcc99 1.5pt solid; BORDER-LEFT: #ffcc99; BACKGROUND-COLOR: #ffffcc; WIDTH: 48pt; BORDER-TOP: #ffcc99; BORDER-RIGHT: olive 1pt solid" class=xl28 width=64 x:num>800</TD></TR></TBODY></TABLE>
what you have done for the removal of the front 7 is absolutely correct however i need the first 2 letters put into a new column to the left of column 1 and remove the columns from First commitment period
can you please help me

 

[VoG]

Try

Sub Atest()
Dim LR As Long, c As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Columns("A").Insert
For Each c In Range("B1:C" & LR)
    With c
        If .Column = 2 Then Range("A" & .Row).Value = Left(.Value, 2)
        .Value = Right(.Value, Len(.Value) - 7)
    End With
Next c
Columns("D").Delete
End Sub

 

[paxodiva]

Your an absolute star and that has worked fantastic
what do i write in the code to remove the -1-1 as a final stage so that i am only left with 547225027 in columns b & c

 

[VoG]

Try

Sub Atest()
Dim LR As Long, c As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Columns("A").Insert
For Each c In Range("B1:C" & LR)
    With c
        If .Column = 2 Then Range("A" & .Row).Value = Left(.Value, 2)
        .Value = Replace(Right(.Value, Len(.Value) - 7), "-1-1", "")
    End With
Next c
Columns("D").Delete
End Sub