Import from sheet 1 to sheet 2

  • Thread starter Thread starter Sverre
  • Start date Start date
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.
 
Thank you Jacob. I will try the program. I just have to change some statments.

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

Jacob Skaria skrev:
 
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
 
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
 
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
 
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
 
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
 
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
 
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
 
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
 
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
 
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
 
Back
Top