Copy Worksheet into Active Workbook

[karabiner8]

I have a macro that prompts the user to select several workbooks and it consolidates some data from each selected workbook into a master file (the one which the macro is run from). It copies a specific range of data from the ExportData worksheet of each of the selected workbooks. The code works fine but now I'd like add some additional code to copy an entire worksheet from the user selected workbooks. The worksheet is always called "Scorecard" and I'd like to copy it to the end of the open workbook.

I would also like to append the contents of cel A2 of Scorecard to the worksheet name (so that I don't get "Scorecard", "Scorecard(1)", "Scorecard(2)", etc. as my worksheet names after the macro runs.

Here is the code:

Sub Combine_BU_Results()

Dim x As Long, z As Variant
Dim bk As Workbook, sh As Worksheet
Dim sh1 As Worksheet

'
' Change the next line to reflect the proper
' name and workbook where the data will be
' consolidated
'

Set sh = Workbooks("Roll Up Master.xls").Worksheets("Consolidate")

z = Application.GetOpenFilename(FileFilter:= _
"Excel files (*.xls), *.xls", MultiSelect:=True)
If Not IsArray(z) Then
MsgBox "Nothing selected"
Exit Sub
End If

'Open loop for action to be taken on all selected workbooks.

Application.ScreenUpdating = False ' turn screen updating off
For x = 1 To UBound(z)

'Open the workbook(s) that were selected.
Set bk = Workbooks.Open(z(x))
'Check if sheet ExportData worksheet exists
On Error Resume Next
Set sh1 = bk.Worksheets("ExportData")
On Error GoTo 0
' if it exists, copy the data
If Not sh1 Is Nothing Then
Set rng = sh1.Range("A1:k100")
Set rng1 = sh.Cells(Rows.Count, 2).End(xlUp)(10)
rng.Copy
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
' sh.Columns.AutoFit add this line back in if you to autofit columns widths

End If

'Close the Roll Up Master workbook without saving it.
Application.CutCopyMode = False
bk.Close False

Next x


'Message box to inform user the job is complete.
Application.ScreenUpdating = False
MsgBox "The import is complete.", 64, "Done !!"
Application.ScreenUpdating = False
Sheets("Scorecard").Select
Range("A1").Select
End Sub

 

[karabiner8]

Is there some trick to posting code in it's own scrollable window?

 

[John Davis]

Is there some trick to posting code in it's own scrollable window?

"

Paste your code here

"