-4

i need to insert copied rows into another worksheet

i write this code and it doesn`t insert it, it gives me error.

Sub IsEmptyExample1()
    Dim wss As Sheets
    Dim ws As Worksheet

    Set wss = ThisWorkbook.Worksheets
    Set ws = wss("Sheet1")
    wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row

    For x = 1 To wsLR
        Cells(x, 1).Select
        If IsEmpty(ActiveCell.Value) = False Then
            ThisWorkbook.Worksheets("sheet1").Rows(x).Select
            Selection.Copy
            Sheets("DE Portal LL").Select
            Selection.Insert Shift:=xlDown
        Else

        End If
    Next x
End Sub
Andras
  • 401
  • 2
  • 15
  • 1
    i write this code and it doesn`t insert it, it gives me error ,,, Sub IsEmptyExample1() Dim wss As Sheets, Dim ws As Worksheet, Set wss = ThisWorkbook.Worksheets, Set ws = wss("Sheet1"), wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row, For x = 1 To wsLR, Cells(x, 1).Select, If IsEmpty(ActiveCell.Value) = False Then, ThisWorkbook.Worksheets("sheet1").Rows(x).Select, Selection.Copy, Sheets("DE Portal LL").Select, Selection.Insert Shift:=xlDown, Else End If Next x End Sub – mohammed elkholyy Oct 06 '19 at 14:09
  • 1
    It would be better to add the code from your comment to the post , also add the description of the error you get and be more concise about that you would like to achieve. – Storax Oct 06 '19 at 14:11

1 Answers1

0

I think you should read this to learn how to avoid using select. You had a few undeclared variables in your code. Your code was also copying a row and then trying to insert a new row onto a worksheet with that data. It would be better to just copy and paste to a new worksheet. Let me know if this helps:

Sub IsEmptyExample2()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim Source As Range
    Set Source = Worksheets("Sheet1").Range(("A1"), Range("A1").End(xlDown).End(xlToRight))

    Dim DestRange As Range
    Set DestRange = Worksheets("DE Portal LL").Range("A1")

    Dim wsLR As Long
    wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row

    Dim x As Long

    For x = 1 To wsLR
        If Cells(x, 1).Value <> "" Then
            Source(x, 1).Rows.EntireRow.Copy
            DestRange(x, 1).PasteSpecial xlPasteAll
        End If
    Next x

End Sub
Miles Fett
  • 711
  • 4
  • 17