Add and Delete sheets

[Risky Dave]

Hi,

I have a workbook that needs to do the following:

1) create a new (temporary) sheet (called "Extract")
2) copy the contents of five separate sheets to adjacent areas of "Extract"
3) copy all of Extract to a new workbook
4) delete Extract from the original workbook

The problem I have is that I don't know the name of the the source workbook
where Extract is created, so I can't work out how to reference it to delete
Extract when I've finished with it. I assume it is possible to create a
string to store the workbook name and reference that string, but doing this
is beyond my meagre (but slowly improving!) VB skills.

Can anyoone provide me with some guidance, please?

Alternatively, if there is a more efficient way of copying the five source
sheets to a single target sheet in a new book feel freee to say.

TIA

Dave

 

[Roger Govier]

High Dave

The following code will help you get started.
This also adds an extra column to the data, giving the name of the Source
sheet.
Set the values of the Const Lastcol and SourceCol to suit your situation,
and the name of the Destination workbook, called Newbook.xls in this example

Sub CombineSheets()

Dim Source As Workbook, dest As Workbook
Dim Sht As Worksheet, SummarySht As Worksheet
Dim NewRow As Long, LastRow As Long
Const Lastcol = "Z" 'Set for last column of data
Const SourceCol = "AA" ' next column to above


Application.ScreenUpdating = False
NewRow = 2
Set Source = ThisWorkbook
Set dest = "Newbook.xls" ' <=== Change to suit

Set SummarySht = dest.Sheets("Sheet1")
SummarySht.Range("2:65536").Delete

For Each Sht In Source.Sheets

LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row
If NewRow + LastRow > 65535 Then
MsgBox "Cannot consolidate all data " _
& "as there are too many rows"
GoTo Endsub
End If
Sht.Range("A2:" & Lastcol & LastRow).Copy _
SummarySht.Range("A" & NewRow)

SummarySht.Range(SourceCol & NewRow & ":" _
& SourceCol & LastRow + NewRow - 1) = Sht.Name
NewRow = NewRow + LastRow - 1

Next Sht

With SummarySht
Columns("A:" & SourceCol).EntireColumn.AutoFit
Range(SourceCol & "1") = "Source"
Range("A2").Activate
ActiveWindow.FreezePanes = True
End With

Application.DisplayAlerts = False
dest.Save
Application.DisplayAlerts = True

Endsub:
Application.ScreenUpdating = True
End Sub

 

[Peter T]

High Dave

Is that a question, as in "are you ...", or a Welsh salutation <g>

Regards,
Peter T

 

[Roger Govier]

Nice one, Peter<bg>

If it was a Welsh greeting, it would be "High Dai"