Code Cleanup for Combining Sheets - vba

Question

I do not have much experience with VBA but I will start by explaining my situation.
I have a workbook with 341 sheets. Each sheet is identical in layout in that they occupy the space A1:J48. I need to combine all of these into one sheet called "COMBINATION". The information of relevance is from A10:J48. I also need to have the cells from A1:J9 as they are the title which is shared across all the sheets.
What I did was write a code that copies A1:J48 for Sheet1 (to get the title and info) and pastes it into "COMBINATION" with the paste special as text, then a code that goes to Sheet2 and copies from A10:J48 and pastes it in the first empty cell in column A of "COMBINATION".
This brings me to my problem. I have realized that there must be an easier way of doing this instead of copying the code 339 more times for each of the sheets.
See below the code. It does what I want correctly but as mentioned, I would like to find a way to not do this 339 more times...
Sheets("Sheet1").Select
Range("A1:J48").Select
Selection.Copy
Sheets("COMBINATION").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Columns.AutoFit
Sheets("Sheet2").Select
Range("A10:J10").Select
Range("J10").Activate
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("COMBINATION").Select
NextFree = Range("A10:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("A" & NextFree).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Answer 1

I would use code like the following:
Dim ws As Worksheet
Dim r As Long
'Copy A1:J9 from the first sheet
Worksheets("Sheet1").Range("A1:J9").Copy
WorkSheets("COMBINATION").Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'Now loop through every sheet (except "COMBINATION") copying cells A10:J48
r = 10 ' first sheet will be copied to row 10 in COMBINATION
For Each ws In Worksheets
If ws.Name <> "COMBINATION" Then
ws.Range("A10:J48").Copy
Worksheets("COMBINATION").Range("A" & r).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'Set pointer ready for next sheet
r = r + 39
End If
Next
'Set column widths
Worksheets("COMBINATION").Columns.AutoFit
If your sheets don't always have data in all 39 rows (10 to 48), replace r = r + 39 with
r = Worksheets("COMBINATION").Range("A" & Worksheets("COMBINATION").Rows.Count).End(xlUp).Row + 1

Answer 2

Put the repeating code into a loop (untested):
Dim i as Integer
For i=2 to 341
Sheets(i).Select
Range("A10:J10").Select
Range("J10").Activate
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("COMBINATION").Select
NextFree = Range("A10:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("A" & NextFree).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i

Answer 3

Range.PasteSpecial xlPasteValues is convenient but slow. It is much faster to define your 'Target' range to be the same size as your source range and do a direct assignment.
Sub CombineData()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Target As Range
With Worksheets("COMBINATION")
.Range("A1:J9").Value = Worksheets("Sheet1").Range("A1:J49").Value
For Each ws In Worksheets
If ws.Name <> .Name Then
Set Target = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
Target.Resize(39, 10).Value = ws.Range("A10:J48").Value
End If
Next
End With
Application.ScreenUpdating = True
End Sub