Import from sheet 1 to sheet 2

S

Sverre

I need a VB program to import data from the first row to the last row in
sheet 1 to sheet 2 . The data in sheet 1 contein up to 60000 rows. I can't
copy the whole cheet an past it into sheet 2 because it will destroy the
defined matrix in a Look up function. Can anyone help me. I have little
knowledge in VBA.
 
S

Sverre

Thank you Jacob. I will try the program. I just have to change some statments.

Jacob Skaria skrev:
 
S

Sverre

Thank you Jacob. I will try the program. I just have to change some statments.

Jacob Skaria skrev:
 
S

Sverre

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
 
S

Sverre

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
 
J

Jacob Skaria

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
 
J

Jacob Skaria

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
 
J

Jacob Skaria

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
 
J

Jacob Skaria

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
 
S

Sverre

I have cahnged th name on the sheets from sheet 1 to Elev data and sheet 2 to
Snitt elev. The debuger tells compile error in this statment.
Sheets("Snitt Elev").Range(Cells(lngLastRow + 1, 1), Cells(lngLastRow +
lngRows,
lngCols)) = varRange

The data in Sheet 1 or Elevdata witch is my name contains text and numbers
I vant to import from row 1.


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("Elevdata").Cells(Rows.Count, "A").End(xlUp).Row
lngCols = Sheets("Elevdata").Cells(1, Columns.Count).End(xlToLeft).Column
varRange = Sheets("Elevdata").Range("A1", Cells(lngRows, lngCols))
Sheets("Snitt elev").Select
lngLastRow = Sheets("Snitt Elev").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Snitt Elev").Range(Cells(lngLastRow + 1, 1), Cells(lngLastRow +
lngRows,
lngCols)) = varRange
Sheets("Sheet1").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
S

Sverre

I have cahnged th name on the sheets from sheet 1 to Elev data and sheet 2 to
Snitt elev. The debuger tells compile error in this statment.
Sheets("Snitt Elev").Range(Cells(lngLastRow + 1, 1), Cells(lngLastRow +
lngRows,
lngCols)) = varRange

The data in Sheet 1 or Elevdata witch is my name contains text and numbers
I vant to import from row 1.


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("Elevdata").Cells(Rows.Count, "A").End(xlUp).Row
lngCols = Sheets("Elevdata").Cells(1, Columns.Count).End(xlToLeft).Column
varRange = Sheets("Elevdata").Range("A1", Cells(lngRows, lngCols))
Sheets("Snitt elev").Select
lngLastRow = Sheets("Snitt Elev").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Snitt Elev").Range(Cells(lngLastRow + 1, 1), Cells(lngLastRow +
lngRows,
lngCols)) = varRange
Sheets("Sheet1").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
J

Jacob Skaria

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("Elevdata").Select
lngRows = Sheets("Elevdata").Cells(Rows.Count, "A").End(xlUp).Row
lngCols = Sheets("Elevdata").Cells(1, Columns.Count).End(xlToLeft).Column
varRange = Sheets("Elevdata").Range("A1", Cells(lngRows, lngCols))
Sheets("Snitt elev").Select
lngLastRow = Sheets("Snitt Elev").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Snitt elev").Range(Cells(lngLastRow + 1, 1), _
Cells(lngLastRow + lngRows, lngCols)) = varRange
Sheets("Elevdata").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

If this post helps click Yes
 
J

Jacob Skaria

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("Elevdata").Select
lngRows = Sheets("Elevdata").Cells(Rows.Count, "A").End(xlUp).Row
lngCols = Sheets("Elevdata").Cells(1, Columns.Count).End(xlToLeft).Column
varRange = Sheets("Elevdata").Range("A1", Cells(lngRows, lngCols))
Sheets("Snitt elev").Select
lngLastRow = Sheets("Snitt Elev").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Snitt elev").Range(Cells(lngLastRow + 1, 1), _
Cells(lngLastRow + lngRows, lngCols)) = varRange
Sheets("Elevdata").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

If this post helps click Yes
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top