Left & Copy

[blackie42]

Hi,

Want to copy contents of cells in column K (sheet1), insert LEFT function (9) and copy to sheet2 column B. Following code looks
like it should work but only copies the first item i.e. K1 to B1

Sub COPYLEFT()
    Dim cell        As Range
    Dim sourceRange As Range

    Set sourceRange = Range(Sheets("Sheet1").Range("K1"), Selection.End(xlDown))

    For Each cell In sourceRange
        If IsEmpty(cell.Value) Then Exit For

        Sheets("Sheet2").Range("B" & cell.Row).Value = Left$(cell.Value, 9)

    Next

End Sub

Any help appreciated

thanks
Jon

[mana]

Sub COPYLEFT()
    Dim cell        As Range
    Dim sourceRange As Range
    
    With Sheets("Sheet1")
        Set sourceRange = .Range("K1", .Range("K" & .Rows.Count).End(xlUp))
    End With
    
    For Each cell In sourceRange
       If IsEmpty(cell.Value) Then Exit For
        
       Sheets("Sheet2").Range("B" & cell.Row).Value = Left$(cell.Value, 9)
        
    Next
     
End Sub

[p45cal]

If there are empty cells amongst the data in column K then it will stop copying at the first empty cell - don't use Exit For.

Sub COPYLEFT()
Dim cell As Range
Dim sourceRange As Range

With Sheets("Sheet1")
  Set sourceRange = .Range("K1", .Range("K" & .Rows.Count).End(xlUp))
End With
For Each cell In sourceRange
  If Not IsEmpty(cell.Value) Then Sheets("Sheet2").Range("B" & cell.Row).Value = Left$(cell.Value, 9)
Next
End Sub

[blackie42]

Thanks Guys,

Both work fine

regards
Jon