Try this..

Sub MergeSheets()
Dim lngRows As Long
Dim lngCols As Long
Dim lngLastRow As Long
Dim varRange As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Sheet1").Select
lngRows = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lngCols = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
varRange = Sheets("Sheet1").Range("A1", Cells(lngRows, lngCols))
Sheets("Sheet2").Select
lngLastRow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range(Cells(lngLastRow + 1, 1), Cells(lngLastRow + lngRows,
lngCols)) = varRange
Sheets("Sheet1").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub--
If this post helps click Yes
---------------
Jacob Skaria


"Jacob Skaria" wrote:

OK..Two questions

1. Is the data is in the same format?
2. Row 1 is having headers or not.

If this post helps click Yes
---------------
Jacob Skaria


"Sverre" wrote:


I have trayed to adapt the program to my needs. Debugging shows Compile
error: Next without For.
What can i do.

Here is my whole adapted sun:

Sub CopyLærerdata()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

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

On Error GoTo 0
Application.DisplayAlerts = True
DestSh.Name = "Snitt Elev"
If LCase(Left(sh.Name, 4)) = "Lærerdata" Then


Set CopyRng = sh.Range("A1:AC1")

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below
this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

'Optional: This 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)

DestSh.Columns.AutoFit

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