VBA Paste Special

[MOB]

Trying to automate the copying of some rows, fails on the paste special section, and I cant figure out why!!

Sub test()
Dim LR As Long, i As Long
With Sheets("Analysis")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 12 To LR
        If .Range("K" & i).Value = "CORB01" Then .Rows(i).Copy
    Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Analysis").Select
                       
    Next i
End With
End Sub

Any help would be great.

Thanks

 

[Peter_SSs]

Your problem is that the paste should only happen if the copy happens.
If K12 does not contain CORB01 then the Copy does not happen. Yet with your code it still tries to paste to the other sheet. Tricky since it hasn't copied anything to paste.

Try this. I've made a couple of changes but the critical thing is to get the Paste inside the IF ... End If block.

Sub test()
Dim LR As Long, i As Long
With Sheets("Analysis")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 12 To LR
        If .Range("K" & i).Value = "CORB01" Then
          .Rows(i).Copy
          Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If
    Next i
    Application.ScreenUpdating = True
End With
End Sub

 

[dmt32]

Hi,
try updates shown in RED

Sub test()
Dim LR As Long, i As Long
With Sheets("Analysis")
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 12 To LR
        If .Range("K" & i).Value = "CORB01" Then
            .Rows(i).Copy
    Sheets("Sheet6").Range("A" & Sheets("Sheet6").Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
       End If
                       
    Next i
End With
End Sub

Dave

 

[Kamolga]

I tested it with small amount of lines (and nothing after column K) and it works, so I guess you reach the limit of lines in sheet 6

column A ​

when you transpose full lines several times

 

[Peter_SSs]

I tested it with small amount of lines (and nothing after column K) and it works, so I guess you reach the limit of lines in sheet 6

column A ​

when you transpose full lines several times

If you are referring to the original code, try it again with cell K12 of 'Analysis' blank

 

[MOB]

Thanks all, got it working now!

One other amendment - where it is searching for "CORB01", I need it to copy if it finds "CORB01", "SEVE01" OR "RUGE01".

Is that an easy amendment?

Thanks

 

[dmt32]

Thanks all, got it working now!

One other amendment - where it is searching for "CORB01", I need it to copy if it finds "CORB01", "SEVE01" OR "RUGE01".

Is that an easy amendment?

Thanks

untested but try

Sub test()
Dim LR As Long, i As Long
With Sheets("Analysis")
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 12 To LR
        Select Case .Range("K" & i).Value
        Case "CORB01", "SEVE01", "RUGE01"
            .Rows(i).Copy
        Sheets("Sheet6").Range("A" & Sheets("Sheet6").Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
       End Select
    Next i
End With
End Sub

Dave

 

[MOB]

That works, many thanks!

 

[Peter_SSs]

If it is only a few values to search for, you could also keep the same structure I posted before with just this one changed line. If it is a largish number of values to search for then the Select Case suggested by Dave would certainly be less cumbersome

<del>If .Range("K" & i).Value = "CORB01" Then</del>
If InStr(1, "|CORB01|SEVE01|RUGE01|", "|" & .Range("K" & i).Value & "|") > 0 Then