VBA copy 1 cell sang cột sheet khác (1 người xem)

[MeThuongNho]

Dear Anh/Chị,
Em không rành VBA nên nhờ mọi người chỉ cái code copy sheet.
Code 1: Khi chạy: sẽ copy value ô E78 sheet Nguồn vào ô J4 sheet Data( và chạy tiếp sẽ là J5 cho tới dòng trống cuối).
Code2: là cho em xin code của 1 vùng (vd B8:G500 Nguồn) sang 1 vùng sheet khác. (i3:N+dong cuối trống của sheet Data).
Xin cám ơn!

 

[MeThuongNho]

Em đã làm được Code 1.
Nhưng muốn thêm điều kiện là ở Cột A: có giá trị or text(tức là <>0): thì cột J mới copy. thì sửa code như thế nào.
Mong được giúp đỡ.

 

[MeThuongNho]

Em đã làm được Code 1.
Nhưng muốn thêm điều kiện là ở Cột A: có giá trị or text(tức là <>0): thì cột J mới copy. thì sửa code như thế nào.
Mong được giúp đỡ.

Code 1: em làm vẫn bị lỗi (lỗi là cập nhật giá trị E78 cho các cell cũ đã nhập trước đó), mong anh em giúp đỡ.

 

[giaiphap]

Em đã làm được Code 1.
Nhưng muốn thêm điều kiện là ở Cột A: có giá trị or text(tức là <>0): thì cột J mới copy. thì sửa code như thế nào.
Mong được giúp đỡ.

Sửa code thế này xem sao?

Sub Copy_Data()
    Application.ScreenUpdating = False
        Dim LastR As Long
        With Sheet4.Range("J65000").End(xlUp).Offset(1)
            If Sheet4.Range("A" & .Row) <> "" Then .Value = Sheet1.Range("E78").Value
        End With
    Application.ScreenUpdating = True
End Sub

 

[MeThuongNho]

Sửa code thế này xem sao?

Sub Copy_Data()
    Application.ScreenUpdating = False
        Dim LastR As Long
        With Sheet4.Range("J65000").End(xlUp).Offset(1)
            If Sheet4.Range("A" & .Row) <> "" Then .Value = Sheet1.Range("E78").Value
        End With
    Application.ScreenUpdating = True
End Sub

Cám ơn rất nhiều giaiphap,
Nếu không cần điều kiện cột A đó nữa, thì sửa sao anh. ( để em học hỏi áp dụng file khác sau này)

Code 1: Khi chạy: sẽ copy value ô E78 sheet Nguồn vào ô J4 sheet Data( và chạy tiếp sẽ là J5 cho tới dòng trống cuối).
Code2: là cho em xin code của 1 vùng (vd B8:G500 Nguồn) sang 1 vùng sheet khác. (i3:N+dong cuối trống của sheet Data).

Cám ơn anh!

 

[giaiphap]

Cám ơn rất nhiều giaiphap,
Nếu không cần điều kiện cột A đó nữa, thì sửa sao anh. ( để em học hỏi áp dụng file khác sau này)
Cám ơn anh!

Trời ơi cái dòng IF đó bạn, bỏ đi là xong. Bạn không biết VBA mà đòi sử dụng VBA để làm gì mất công mệt vậy.

 

[HieuCD]

Dear Anh/Chị,
Em không rành VBA nên nhờ mọi người chỉ cái code copy sheet.
Code 1: Khi chạy: sẽ copy value ô E78 sheet Nguồn vào ô J4 sheet Data( và chạy tiếp sẽ là J5 cho tới dòng trống cuối).
Code2: là cho em xin code của 1 vùng (vd B8:G500 Nguồn) sang 1 vùng sheet khác. (i3:N+dong cuối trống của sheet Data).
Xin cám ơn!

Option Explicit
Sub Test1()
  Sheets("Data").Range("J" & Rows.Count).End(xlUp).Offset(1).Value = Sheets("Nguon").Range("E78").Value
End Sub

Sub Test2()
  Dim dArr As Variant, lRow As Long, ik As Long, j As Byte
  dArr = Sheets("Nguon").Range("B8:G500").Value
  With Sheets("Data")
    For j = Range("I1").Column To Range("N1").Column
      ik = .Cells(Rows.Count, j).End(xlUp).Row + 1
      If lRow < ik Then lRow = ik
    Next j
    .Range("I" & lRow).Resize(UBound(dArr), UBound(dArr, 2)).Value = dArr
  End With
End Sub

 

[MeThuongNho]

Option Explicit
Sub Test1()
  Sheets("Data").Range("J" & Rows.Count).End(xlUp).Offset(1).Value = Sheets("Nguon").Range("E78").Value
End Sub

Sub Test2()
  Dim dArr As Variant, lRow As Long, ik As Long, j As Byte
  dArr = Sheets("Nguon").Range("B8:G500").Value
  With Sheets("Data")
    For j = Range("I1").Column To Range("N1").Column
      ik = .Cells(Rows.Count, j).End(xlUp).Row + 1
      If lRow < ik Then lRow = ik
    Next j
    .Range("I" & lRow).Resize(UBound(dArr), UBound(dArr, 2)).Value = dArr
  End With
End Sub

Cám ơn anh HieuCD,
Em có file Demo đính kèm: dữ liệu nhiều nên code trên không làm nhanh được.
Em đang làm thủ công như sau:
+ Có tổng cộng số thứ tự ( cột A_ sheet "Data") là 4119.
+ Với mỗi STT này bên sheet "Do" sẽ tính ra được 1 giá ( kết quả tại ô E78).
+ Khi có giá thì em chạy code Test 1 trong file : nó sẽ cập nhật : số thứ tự tính giá và giá vào cột Q, R sheet "Data".
Nhưng cứ click chọn từng STT thì rất lâu, có cách nào cho chạy tiếp tục các số từ 1-4119 1 lần luôn được không anh
Mong được giúp đỡ.
Cám ơn rất nhiều!

 

[HieuCD]

Cám ơn anh HieuCD,
Em có file Demo đính kèm: dữ liệu nhiều nên code trên không làm nhanh được.
Em đang làm thủ công như sau:
+ Có tổng cộng số thứ tự ( cột A_ sheet "Data") là 4119.
+ Với mỗi STT này bên sheet "Do" sẽ tính ra được 1 giá ( kết quả tại ô E78).
+ Khi có giá thì em chạy code Test 1 trong file : nó sẽ cập nhật : số thứ tự tính giá và giá vào cột Q, R sheet "Data".
Nhưng cứ click chọn từng STT thì rất lâu, có cách nào cho chạy tiếp tục các số từ 1-4119 1 lần luôn được không anh
Mong được giúp đỡ.
Cám ơn rất nhiều!

Tính trên range nên code chạy hơi lâu

Sub MTN()
  Dim Stt As Long, i As Long, Arr As Variant
  Stt = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row - 3
  If Stt < 1 Then MsgBox ("Khong có du lieu, thoat Sub"): Exit Sub
  ReDim Arr(1 To Stt, 1 To 2)
  Application.ScreenUpdating = False
  With Sheets("Do")
    For i = 1 To Stt
      .Range("A6") = i
      Arr(i, 1) = i
      Arr(i, 2) = .Range("E78").Value
    Next i
  End With
  Sheets("Data").Range("Q4:R4").Resize(Stt) = Arr
  Application.ScreenUpdating = True
End Sub

 

[MeThuongNho]

Tính trên range nên code chạy hơi lâu

Sub MTN()
  Dim Stt As Long, i As Long, Arr As Variant
  Stt = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row - 3
  If Stt < 1 Then MsgBox ("Khong có du lieu, thoat Sub"): Exit Sub
  ReDim Arr(1 To Stt, 1 To 2)
  Application.ScreenUpdating = False
  With Sheets("Do")
    For i = 1 To Stt
      .Range("A6") = i
      Arr(i, 1) = i
      Arr(i, 2) = .Range("E78").Value
    Next i
  End With
  Sheets("Data").Range("Q4:R4").Resize(Stt) = Arr
  Application.ScreenUpdating = True
End Sub

Cám ơn anh HieuCD nhiều lắm.
Cho em hỏi thêm, nếu em muốn gán thẳng kết quả giá luôn ( để khỏi vlookup theo Stt nữa ).
: kết quả giá đó nằm cột T4: trở xuống. Vậy code sửa sao anh.
Em làm vầy nhưng k biết có dư hay sai j không

bỏ dòng :   Arr(i, 1) = i
và sửa dòng: Sheets("Data").Range("Q4:R4").Resize(Stt) = Arr thành
Sheets("Data").Range("S4:T4").Resize(Stt) = Arr

Anh xem giúp em nha.
Trân trọng!

 

[HieuCD]

Cám ơn anh HieuCD nhiều lắm.
Cho em hỏi thêm, nếu em muốn gán thẳng kết quả giá luôn ( để khỏi vlookup theo Stt nữa ).
: kết quả giá đó nằm cột T4: trở xuống. Vậy code sửa sao anh.
Em làm vầy nhưng k biết có dư hay sai j không

bỏ dòng :   Arr(i, 1) = i
và sửa dòng: Sheets("Data").Range("Q4:R4").Resize(Stt) = Arr thành
Sheets("Data").Range("S4:T4").Resize(Stt) = Arr

Anh xem giúp em nha.
Trân trọng!

Sub MTN()
  Dim Stt As Long, i As Long, Arr As Variant
  Stt = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row - 3
  If Stt < 1 Then MsgBox ("Khong có du lieu, thoat Sub"): Exit Sub
  ReDim Arr(1 To Stt, 1 To 1)
  Application.ScreenUpdating = False
  With Sheets("Do")
   For i = 1 To Stt
     .Range("A6") = i
     Arr(i, 1) = .Range("E78").Value
   Next i
  End With
  Sheets("Data").Range("T4").Resize(Stt) = Arr
  Application.ScreenUpdating = True
End Sub

 

[MeThuongNho]

Cám ơn anh HieuCD !