Left & Copy

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

Code:

---

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

Code:

---

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

---

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.

Code:

---

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

---

Thanks Guys,

Both work fine

regards
Jon