Macro HELP

[Christina]

I'm using the following code (author - Ron de Bruin) and need it to
add the worksheets to the workbook I have open instead of creating a
new workbook. Let's say the workbook I have open is "Christina.xls".
This is the workbook where I will be running the macro from.


Sub Get_Sheet(PasteAsValues As Boolean, SourceShName As String, _
SourceShIndex As Integer, myReturnedFiles As Variant)
Dim mybook As Workbook, BaseWks As Worksheet
Dim CalcMode As Long
Dim SourceSh As Variant
Dim sh As Worksheet
Dim I As Long

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

On Error GoTo ExitTheSub

'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)


'Check if we use a named sheet or the index
If SourceShName = "" Then
SourceSh = SourceShIndex
Else
SourceSh = SourceShName
End If

'Loop through all files in the array(myFiles)
For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(myReturnedFiles(I))
On Error GoTo 0

If Not mybook Is Nothing Then

'Set sh and check if it is a valid
On Error Resume Next
Set sh = mybook.Sheets(SourceSh)

If Err.Number > 0 Then
Err.Clear
Set sh = Nothing
End If
On Error GoTo 0

If Not sh Is Nothing Then
sh.Copy
after:=BaseWks.Parent.Sheets(BaseWks.Parent.Sheets.Count)

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

If PasteAsValues = True Then
With ActiveSheet.UsedRange
.Value = .Value
End With
End If

End If
'Close the workbook without saving
mybook.Close savechanges:=False
End If

'Open the next workbook
Next I

' delete the first sheet in the workbook
Application.DisplayAlerts = False
On Error Resume Next
BaseWks.Delete
On Error GoTo 0
Application.DisplayAlerts = True

ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub

 

[Dave Peterson]

Untested, but I think it'll work:

Change this:
'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1

to:

'Add a new worksheet to the workbook with the macro
Set BaseWks = thisworkbook.worksheets.add

 

[Christina]

Untested, but I think it'll work:

Change this:
    'Add a new workbook with one sheet
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1

to:

    'Add a new worksheet to the workbook with the macro
    Set BaseWks = thisworkbook.worksheets.add






















--

Dave Peterson- Hide quoted text -

- Show quoted text -

That worked! Thanks for your help!