Using rng2.Select gives error 1004

[trbogaert]

Hi there,

I'm trying to make a macro (in excel 2007) that copies a value if the cell next to it has '1' as value, and then paste it into another sheet, without empty cells. For example:

1 - Value 1
0 - Value 2
1 - Value 3
1 - Value 4
0 - Value 5

Makes:

Value 1
Value 3
Value 4

The following macro is what I think should work, but I keep getting an error 1004 (I don't know the english error discription, but it should be something like 'Method Select of Class Range failed). It then highlights 'rng2.Select'. Can anyone help me with this? Thanks!

Private Sub CommandButton1_Click()
 
Dim rng1 As Range
Dim rng2 As Range
 
Sheets("Printen").Activate
ActiveSheet.Range("A:A").Select
Selection.Delete
Sheets("Selecteren").Activate
Set rng2 = Range("A1")
 
ActiveSheet.Range("C4").Select
 
Do While IsEmpty(ActiveCell) = False
 
If Selection.Value = 1 Then
 
Set rng1 = ActiveCell
 
ActiveCell.Offset(0, 1).Select
Selection.Copy
 
Sheets("Printen").Activate
rng2.Select
 
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
ActiveCell.Offset(1, 0).Select
Set rng2 = ActiveCell
 
Sheets("Selecteren").Activate
rng1.Select
 
End If
 
ActiveCell.Offset(1, 0).Select
Loop
 
Application.CutCopyMode = False

 

[Gary McMaster]

I tried the code you posted and didn't get any errors (XL 2000) but it didn't copy anything either (probably had data in wrong place). You didn't specify where the data was located so the following sample assumes the ones and zeroes (numeric) are in column A and "Value 1" - "Value 5" are in column B of the sheet titled "Selecteren". The data is copied to the sheet titled "Printen" starting in cell "A1".

Please notice that you don't have to "Select" or "Activate" anything to accomplish something like this. The macro recorder is notorious for starting people down the Select and Activate path.

Hope it helps.

Gary

Private Sub CommandButton1_Click()

Dim oCell As Range
Dim oCopyTo As Range
Dim oScan As Range
 
Dim oSht1 As Worksheet
Dim oSht2 As Worksheet

Dim lLastRow As Long

'Set sheet references for convenience and less typing later
Set oSht1 = ThisWorkbook.Worksheets("Selecteren")
Set oSht2 = ThisWorkbook.Worksheets("Printen")

'Last used row in column A
lLastRow = oSht1.Range("A" & Rows.Count).End(xlUp).Row ' Last row used in column A "Selecteren" sheet

oSht2.Range("A:A").ClearContents ' Clear "Printen" sheet column A

Set oCopyTo = oSht2.Range("A1") ' Start copying "Printen" sheet cell "A1"

Set oScan = oSht1.Range("A1:A" & lLastRow) ' Used range on "Selecteren" A1 to last used row

For Each oCell In oScan ' Visit each used cell in column A of "Selecteren"
    If oCell.Value = 1 Then
        oCopyTo.Value = oCell.Offset(0, 1).Text ' Copy from "Selecteren" to "Printen"
        Set oCopyTo = oCopyTo.Offset(1, 0) ' Move copy destination down 1 row
    End If
Next oCell

End Sub

 

[trbogaert]

Thanks a lot, it works great!

The only thing is that I would really like to copy the text including the format, as the list will contain different formats as wel (Headers and such). Would you happen to know a sollution for that as well?

 

[Gary McMaster]

There are so many things that could be different about formats from one cell to the next that I suspect using "PasteSpecial" (as you started out doing) may be the easiest way to do it. However, you could read the individual format properties from the source cell and set that same property in the destination cell to match if you wanted to. It would be a lot more work but if you're looking for practice ...

There may also be a method to copy the format all at once without using copy paste. If it exists I don't remember ever using it but I usually work with raw data that doesn't have a lot of formatting and have never had the need.

Gary

Private Sub CommandButton1_Click()

Dim oCell As Range
Dim oCopyTo As Range
Dim oScan As Range
 
Dim oSht1 As Worksheet
Dim oSht2 As Worksheet

Dim lLastRow As Long

'Set sheet references for convenience and less typing later
Set oSht1 = ThisWorkbook.Worksheets("Selecteren")
Set oSht2 = ThisWorkbook.Worksheets("Printen")

'Last used row in column A
lLastRow = oSht1.Range("A" & Rows.Count).End(xlUp).Row ' Last row used in column A "Selecteren" sheet

oSht2.Range("A:A").ClearContents ' Clear "Printen" sheet column A

Set oCopyTo = oSht2.Range("A1") ' Start copying "Printen" sheet cell "A1"

Set oScan = oSht1.Range("A1:A" & lLastRow) ' Used range on "Selecteren" A1 to last used row

For Each oCell In oScan ' Visit each used cell in column A of "Selecteren"
    If oCell.Value = 1 Then
    
        oCopyTo.Value = oCell.Offset(0, 1).Text ' Copy from "Selecteren" to "Printen"
        
        'Copy format from each targeted cell of "Selecteren" sheet to "Printen" sheet
        oCell.Offset(0, 1).Copy
        oCopyTo.PasteSpecial xlPasteFormats
        
        Set oCopyTo = oCopyTo.Offset(1, 0) ' Move copy destination down 1 row
        
    End If
Next oCell

End Sub

 

[Norie]

Can't you just use Copy instead of Copy/PasteSpecial?

rng1.Copy rng2

 

[Gary McMaster]

Can't you just use Copy instead of Copy/PasteSpecial?

Norie's suggestion would look like the following in the foreach loop in my sample. Thanks Norie much better idea.

For Each oCell In oScan ' Visit each used cell in column A of "Selecteren"
    If oCell.Value = 1 Then
    
        oCell.Offset(0, 1).Copy oCopyTo
        Set oCopyTo = oCopyTo.Offset(1, 0) ' Move copy destination down 1 row
        
    End If
Next oCell

 

[Norie]

Gary

The only thing is that there might be a reason the OP used Copy/PasteSpecial in the original code.

eg formulas

I didn't see anything but you never know.