Snasui Excel Forum

Code: Select all

If Application.CountIf(Sheets("Sheet1") _
    .Range("a2").Resize(100000), "<>") > 0 Then
    Sheets("Sheet1").Range("a2").Resize(100000) _
        .SpecialCells(xlCellTypeConstants).Resize(, 3) _
        .Copy Sheets("Sheet2").Range("a1")
End If

Code: Select all

Dim lastrow As Integer, erow As Integer, sheet1 As Worksheet, sheet2 As Worksheet
Set sheet1 = Worksheets("Sheet1")
Set sheet2 = Worksheets("Sheet2")
lastrow = sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
sheet1.Cells(i, 1).Copy
erow = sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
sheet1.Paste Destination:=sheet2.Cells(erow, 1)
sheet1.Cells(i, 2).Copy
sheet1.Paste Destination:=sheet2.Cells(erow, 2)
sheet1.Cells(i, 3).Copy
sheet1.Paste Destination:=sheet2.Cells(erow, 3)
Next i
Application.CutCopyMode = False
sheet2.Columns().AutoFit
Range("A1").Select
End Sub

Code: Select all

Dim Lastrow As Long, Erow As Long

Lastrow = Sheet1.Cells(Rows.Count, 1).End(xIUp).Row
For i = 2 To Lastrow
Sheet1.Cells(i, 1).Copy
Erow = Sheet2.Cells(Rows.Count, 1).End(xIUp).Offset(1, 0).Row

Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(Erow, 1)

Sheet1.Cells(i, 2).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(Erow, 2)

Sheet1.Cells(i, 3).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(Erow, 3)

Next i
Application.CutCopyMode = False
Sheet2.Columns().AutoFit
Range("A1").Select