macro required

[Legacy 178446]

Hi there,

I have values in two columns A and C. I need to write a macro to copy the values in every 11th cell in both columns to a new worksheet. The first value in column A that I would like to copy is in row 32. So the subsequent values are in rows 43,54,65 etc. In column c, the first value is in row 36. So the subsequent values are in rows 47,58,69 etc. The number of rows is varies. The code I'm using is:

Sub Copy10()
Dim LR As Long, i As Long, ws As Worksheet
Set ws = ActiveSheet
Worksheets.Add
With ws
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 32 To LR Step 11
        .Range("A" & i).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next i
    LR = .Range("C" & Rows.Count).End(xlUp).Row
    For i = 36 To LR Step 11
        .Range("A" & i).Copy Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1)
    Next i
End With
End Sub

Im getting error message when I do this even though this code has worked before! It just says 'microsoft visual basci' and '400' Does anyone know where i'm going wrong?

Thanks in advance for the help.

 

[VoG]

Should it not be?

Sub Copy10()
Dim LR As Long, i As Long, ws As Worksheet
Set ws = ActiveSheet
Worksheets.Add
With ws
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 32 To LR Step 11
        .Range("A" & i).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next i
    LR = .Range("C" & Rows.Count).End(xlUp).Row
    For i = 36 To LR Step 11
        .Range("C" & i).Copy Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1)
    Next i
End With
End Sub

 

[Legacy 178446]

still getting that visual basic error message '400'.

 

[VoG]

Click Debug: which line of code is highlighted?

 

[Legacy 178446]

It doesnt highlight any line just displays the error message and the only option is to click 'ok' or 'help' which direct you to the MS website!

 

[VoG]

Run this: what message is displayed?

Sub Copy10()
Dim LR As Long, i As Long, ws As Worksheet
On Error GoTo Alert
Set ws = ActiveSheet
Worksheets.Add
With ws
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 32 To LR Step 11
        .Range("A" & i).Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next i
    LR = .Range("C" & Rows.Count).End(xlUp).Row
    For i = 36 To LR Step 11
        .Range("C" & i).Copy Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1)
    Next i
End With
Exit Sub
Alert:
MsgBox Err.Description
End Sub

 

[Legacy 178446]

'cannot change part of a merged cell' any ideas?

 

[VoG]

Yes, unmerge them http://www.mrexcel.com/forum/showthread.php?t=335123

 

[Legacy 178446]

back in business, thank you very much from a very stressed phd student handing in in 2 weeks!!

 

[VoG]

You are welcome. Good luck with the viva.