CODEWITHSUNDEEP
excelvbacopy
Prabhu
Prabhu

Reputation: 39

Copy data with in sheets

enter image description hereThere are 2 sheets, Sheet1 and Sheet2. Sheet1 contain 10 columns and 5 rows with data including blank.

The requirement is to copy the data from Sheet 1 and to put in another sheet Sheet 2, wherein only populate the cell which is not blank.

I get the run time error 1004 - Application or object defined error.

The code snippet is:-

 Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
 Set wsht2 = Sheets("Sheet2")
 finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row

 For i = 1 To finalrow
 If wsht1.Cells(i, 1).Value <> " " Then
    Range(Cells(i, 2), Cells(i, 2)).Copy 
        Worksheets("Sheet2").Select
        wsht2.Range(Cells(1, i)).PasteSpecial Paste:=xlPasteFormats

    End If
Next i

Can u help me in sorting this out?

Upvotes: 0

Views: 47

Answers (3)

Shai Rado
Shai Rado

Reputation: 33672

The code below will copy only values in Column A (non-empty cells) from Sheet 1 to Sheet2:

Dim j                           As Long

Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
Set wsht2 = Sheets("Sheet2")
finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row

j = 1
For i = 1 To finalrow
    With wsht1
        ' if you compare to empty string, you need to remove the space inside the quotes
        If .Cells(i, 1).Value <> "" And .Cells(i, 1).Value <> " " Then
            .Cells(i, 1).Copy ' since you are copying a single cell, there's no need to use a Range
            wsht2.Range("A" & j).PasteSpecial Paste:=xlPasteValues, Paste:=xlPasteFormats
            j = j + 1
        End If
    End With
Next i

Upvotes: 0

Tim Wilkinson
Tim Wilkinson

Reputation: 3801

If you only have 5 cells with data in Sheet 1 and only want those 5 rows copying to Sheet 2 use the following, similar to Shai's answer above with an extra counter for the rows in Sheet 2.

Sub copying()

Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
Set wsht2 = Sheets("Sheet2")
finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row
k = 1

For i = 1 To finalrow
    If wsht1.Cells(i, 1).Value <> "" Then
        For j = 1 To 5
            wsht2.Cells(k, j).Value = wsht1.Cells(i, j).Value
        Next j
        k = k + 1
    End If
Next i
End Sub

EDIT

As per your comment if you want to dynamically change j replace For j = 1 To 5 with

For j = 1 To wsht1.Cells(i, Columns.Count).End(xlToLeft).Column

Upvotes: 1

tretom
tretom

Reputation: 625

You cannot define a range like that:

wsht2.Range(Cells(1, i))

you might use: 

wsht2.Cells(1, i).PasteSpecial Paste:=xlPasteFormats

BTW: with this code you won't find empty cells:

If wsht1.Cells(i, 1).Value <> " " Then

you should use:

If wsht1.Cells(i, 1).Value <> "" Then

(the difference is a missing space between the quotes)

if you want to copy the values only and to make it with a loop I'd do the following:

Sub copying()

    Set wsht1 = ThisWorkbook.Worksheets("Sheet1")
     Set wsht2 = Sheets("Sheet2")
     finalrow = wsht1.Cells(wsht1.Rows.Count, 1).End(xlUp).Row

 For i = 1 To finalrow
    If wsht1.Cells(i, 1).Value <> "" Then
        For j = 1 To 5
            wsht2.Cells(i, j).Value = wsht1.Cells(i, j).Value
        Next j
    End If
Next i


End Sub

Upvotes: 1

Related Questions