Nhờ tạo Macro copy dữ liệu

Liên hệ QC
tanlahill

tanlahill

Thành viên chính thức
Tham gia
2/9/08
Bài viết
68
Được thích
138
Nghề nghiệp
Kinh doanh
:<>:<>:<> Nhờ các thành viên sớm giúp tôi file đính kèm theo yêu cầu có sẵn trong file. Cám ơn rất nhiều. :<>:<>:<>
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Không đọc được font là không đọc được font, . . . .

Làm sao đọc được file này các bạn ơi?
:-= --=0 :-=
(Mình xài unicode)
 
Upvote 0
ChanhTQ@ đã viết:
Làm sao đọc được file này các bạn ơi?
:-= --=0 :-=
(Mình xài unicode)
Nhấp chuột vào đây để mở rộng...
Theo mình nghĩ font chẳng có vấn đề gì đâu! Mình dùng font VNI-Times mà! Có lẽ do mình chọn size = 8 nhỏ quá nên nó hiện chữ nhìn giống bị không đúng font thôi. Các bạn chọn size lớn hơn tí (size = 12) xem sao!
Cám ơn.
 
Upvote 0
tanlahill đã viết:
Theo mình nghĩ font chẳng có vấn đề gì đâu! Mình dùng font VNI-Times mà! Có lẽ do mình chọn size = 8 nhỏ quá nên nó hiện chữ nhìn giống bị không đúng font thôi. Các bạn chọn size lớn hơn tí (size = 12) xem sao!
Cám ơn.
Nhấp chuột vào đây để mở rộng...
Bạn dùng thử code sau:
PHP: 
Sub CopyData()
Dim endR As Long
Sheets("BCNX").Select
Range("B9:Y10000").ClearContents
endR = Cells(65000, 1).End(xlUp).Row
If endR <= 8 Then Exit Sub
Range("B9:Y" & endR).Value = Range("B8:Y8").Value
End Sub
 
Upvote 0
Cám ơn và xin hoàn thiện thêm!

ThuNghi đã viết:
Bạn dùng thử code sau:
PHP: 
Sub CopyData()
Dim endR As Long
Sheets("BCNX").Select
Range("B9:Y10000").ClearContents
endR = Cells(65000, 1).End(xlUp).Row
If endR <= 8 Then Exit Sub
Range("B9:Y" & endR).Value = Range("B8:Y8").Value
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn rất nhiều. Nhưng code của bạn tôi xin được phép điều chỉnh như sau mới đúng ý chứ không nó copy toàn value cả dù các cell ở row8 có chưa công thức.

...
If endR <= 8 Then MsgBox "Hay nhap gia tri bat dau vao cell A8": Exit Sub
Range("B8:Y8").Copy Range("B9:Y" & endR)
...

Như vậy là OK rồi! Nếu được bạn hoặc các thành viên GPE có thể bổ sung thêm cho tôi một ý nữa cho nó hoàn hảo nhé!
Cũng là ý đó thôi nhưng tôi chỉ cần nhập một giá trị (number) nào đó vào cell A8 rồi Click nút "Cập nhật" thì Macro sẽ lấy giá trị đó (cell A8) dò tìm sang cột A (cột TT) của sheet("NKNX") nếu gặp ở chổ nào thì copy từ đó trở xuống paste sang cột A của sheet ("BCNX") bắt đầu ở cell A8 rồi tiếp đến là các lệnh như bạn đã làm.

Rất mong sớm nhận được sự trợ giúp của bạn cùng tất cả các thành viên trên GPE!
 
Upvote 0
Cám ơn và xin hoàn thiện thêm!

ThuNghi đã viết:
Bạn dùng thử code sau:
PHP: 
Sub CopyData()
Dim endR As Long
Sheets("BCNX").Select
Range("B9:Y10000").ClearContents
endR = Cells(65000, 1).End(xlUp).Row
If endR <= 8 Then Exit Sub
Range("B9:Y" & endR).Value = Range("B8:Y8").Value
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn rất nhiều. Nhưng code của bạn tôi xin được phép điều chỉnh như sau mới đúng ý chứ không nó copy toàn value cả dù các cell ở row8 có chưa công thức.

...
If endR <= 8 Then MsgBox "Hay nhap gia tri bat dau vao cell A8": Exit Sub
Range("B8:Y8").Copy Range("B9:Y" & endR)
...

Như vậy là OK rồi! Nếu được bạn hoặc các thành viên GPE có thể bổ sung thêm cho tôi một ý nữa cho nó hoàn hảo nhé!
Cũng là ý đó thôi nhưng tôi chỉ cần nhập một giá trị (number) nào đó vào cell A8 rồi Click nút "Cập nhật" thì Macro sẽ lấy giá trị đó (cell A8) dò tìm sang cột A (cột TT) của sheet("NKNX") nếu gặp ở chổ nào thì copy từ đó trở xuống paste sang cột A của sheet ("BCNX") bắt đầu ở cell A8 rồi tiếp đến là các lệnh như bạn đã làm.

Ví dụ: Tôi nhập vào cell A8 là 3 rồi Click... thì KQ là A8=3; A9=4; A10=5 và A11=6 hoặc
cell A8 là 5 rồi Click... thì KQ là A8=5; A9=6

Rất mong sớm nhận được sự trợ giúp của bạn cùng tất cả các thành viên trên GPE!
 
Upvote 0
tanlahill đã viết:
Cám ơn bạn rất nhiều. Nhưng code của bạn tôi xin được phép điều chỉnh như sau mới đúng ý chứ không nó copy toàn value cả dù các cell ở row8 có chưa công thức.

...
If endR <= 8 Then MsgBox "Hay nhap gia tri bat dau vao cell A8": Exit Sub
Range("B8:Y8").Copy Range("B9:Y" & endR)
...

Như vậy là OK rồi! Nếu được bạn hoặc các thành viên GPE có thể bổ sung thêm cho tôi một ý nữa cho nó hoàn hảo nhé!
Cũng là ý đó thôi nhưng tôi chỉ cần nhập một giá trị (number) nào đó vào cell A8 rồi Click nút "Cập nhật" thì Macro sẽ lấy giá trị đó (cell A8) dò tìm sang cột A (cột TT) của sheet("NKNX") nếu gặp ở chổ nào thì copy từ đó trở xuống paste sang cột A của sheet ("BCNX") bắt đầu ở cell A8 rồi tiếp đến là các lệnh như bạn đã làm.

Ví dụ: Tôi nhập vào cell A8 là 3 rồi Click... thì KQ là A8=3; A9=4; A10=5 và A11=6 hoặc
cell A8 là 5 rồi Click... thì KQ là A8=5; A9=6

Rất mong sớm nhận được sự trợ giúp của bạn cùng tất cả các thành viên trên GPE!
Nhấp chuột vào đây để mở rộng...
Bạn nên gom bớt bài lại. Dùng code sau nhé.
PHP: 
Sub CopyData()
Dim endR As Long, SoDau As Long, SoCuoi As Long
Sheets("BCNX").Select
Range("A9:A10000").ClearContents
SoDau = Range("A8")
With Sheets("NKNX")
  endR = .Cells(65000, 2).End(xlUp).Row
  SoCuoi = .Cells(endR, 2).Value
End With
If SoCuoi < SoDau Then Exit Sub
Range("A" & 8 + SoCuoi - SoDau).Value = SoCuoi
With Range("A9:A" & 8 + SoCuoi - SoDau - 1)
  .FormulaR1C1 = "=+R[-1]C+1"
  .Value = .Value
End With
Range("B9:Y10000").ClearContents
endR = 8 + SoCuoi - SoDau
Range("B9:Y" & endR).Value = Range("B8:Y8").Value
End Sub
 
Upvote 0
Cám ơn và xin hoàn thiện thêm!

ThuNghi đã viết:
Bạn nên gom bớt bài lại. Dùng code sau nhé.
PHP: 
Sub CopyData()
Dim endR As Long, SoDau As Long, SoCuoi As Long
Sheets("BCNX").Select
Range("A9:A10000").ClearContents
SoDau = Range("A8")
With Sheets("NKNX")
  endR = .Cells(65000, 2).End(xlUp).Row
  SoCuoi = .Cells(endR, 2).Value
End With
If SoCuoi < SoDau Then Exit Sub
Range("A" & 8 + SoCuoi - SoDau).Value = SoCuoi
With Range("A9:A" & 8 + SoCuoi - SoDau - 1)
  .FormulaR1C1 = "=+R[-1]C+1"
  .Value = .Value
End With
Range("B9:Y10000").ClearContents
endR = 8 + SoCuoi - SoDau
Range("B9:Y" & endR).Value = Range("B8:Y8").Value
End Sub
Nhấp chuột vào đây để mở rộng...

Cám ơn bạn rất nhiều. Đúng như yêu cầu rồi nhưng code thi hành vẫn còn một số vướng mắc sau:
1./ Cột tham chiếu ở NKNX là A
…
endR = .Cells(65000, 2).End(xlUp).Row
SoCuoi = .Cells(endR, 2).Value
…
Tôi đã sửa thành 1 và đã OK rồi. Bạn kiểm tra những điều tiếp nhé!
2./ Giá trị BCNX!A8 < MAX(NKNX!A(n)) 1 đơn vị (Nghĩa là BCNX!A8 nhỏ hơn số cuối 1 đ.vị) thì KQuả BCNX cells A8=1; A9=2 Như vậy thì không đúng!
3./ Giá trị BCNX!A8 = MAX(NKNX!A(n)) thì KQuả BCNX cells A8=2; A9=3 và có thêm A7=1 nữa!
4./ Cột A của NKNX là các số tự nhiên liên tiếp >=1. Nếu được bạn có thể thêm MsgBox để ngăn những giá trị < 1hoặc là text
Bạn vui lòng kiểm tra và Sớm cập nhật giúp tôi.
Một lần nữa, xin cám ơn.
PS: Vừa rồi do mạng nghẽn gởi bài mấy cũng không được nên mình đã Click nhiều lần và kết quả là thế. Có cách nào xóa bớt đi không bạn?
 
Upvote 0
tanlahill đã viết:
Cám ơn bạn rất nhiều. Đúng như yêu cầu rồi nhưng code thi hành vẫn còn một số vướng mắc sau:
1./ Cột tham chiếu ở NKNX là A
…
endR = .Cells(65000, 2).End(xlUp).Row
SoCuoi = .Cells(endR, 2).Value
…
Tôi đã sửa thành 1 và đã OK rồi. Bạn kiểm tra những điều tiếp nhé!
2./ Giá trị BCNX!A8 < MAX(NKNX!A(n)) 1 đơn vị (Nghĩa là BCNX!A8 nhỏ hơn số cuối 1 đ.vị) thì KQuả BCNX cells A8=1; A9=2 Như vậy thì không đúng!
3./ Giá trị BCNX!A8 = MAX(NKNX!A(n)) thì KQuả BCNX cells A8=2; A9=3 và có thêm A7=1 nữa!
4./ Cột A của NKNX là các số tự nhiên liên tiếp >=1. Nếu được bạn có thể thêm MsgBox để ngăn những giá trị < 1hoặc là text
Bạn vui lòng kiểm tra và Sớm cập nhật giúp tôi.
Một lần nữa, xin cám ơn.
PS: Vừa rồi do mạng nghẽn gởi bài mấy cũng không được nên mình đã Click nhiều lần và kết quả là thế. Có cách nào xóa bớt đi không bạn?
Nhấp chuột vào đây để mở rộng...
Sorry, do lúc đầu chưa lường hết và chưa test cẩn thận.
Bạn sử dụng code sau, nếu OK thì sẽ rút gọn lại theo dạng select case endr
PHP: 
4./ Cột A của NKNX là các số tự nhiên liên tiếp >=1.
Số này đương nhiên là số và > 1 rồi.
=IF(C7="","",ROW()-6)
PHP: 
Sub CopyData()
Dim endR As Long, SoDau As Long, SoCuoi As Long
Sheets("BCNX").Select
Range("A9:A10000").ClearContents
SoDau = Range("A8")
With Sheets("NKNX")
  endR = .Cells(65000, 2).End(xlUp).Row
  SoCuoi = .Cells(endR, 2).Value
End With
If SoCuoi < SoDau Then Exit Sub
endR = 8 + SoCuoi - SoDau
If endR = 8 Then
  Range("A" & 8 + SoCuoi - SoDau).Value = SoCuoi
  Range("B9:Y10000").ClearContents
  Exit Sub
Else
  Range("B9:Y10000").ClearContents
  Range("B9:Y" & endR - 1).Value = Range("B8:Y8").Value
End If
If SoCuoi - SoDau = 1 Then
  Range("A9") = SoCuoi
Else
  With Range("A9:A" & 8 + SoCuoi - SoDau - 1)
    .FormulaR1C1 = "=+R[-1]C+1"
    .Value = .Value
  End With
End If

End Sub
 
Upvote 0
Cám ơn nhưng vẫn chưa ổn!

ThuNghi đã viết:
Sorry, do lúc đầu chưa lường hết và chưa test cẩn thận.
Bạn sử dụng code sau, nếu OK thì sẽ rút gọn lại theo dạng select case endr
PHP: 
4./ Cột A của NKNX là các số tự nhiên liên tiếp >=1.
Số này đương nhiên là số và > 1 rồi.
=IF(C7="","",ROW()-6)
PHP: 
Sub CopyData()
Dim endR As Long, SoDau As Long, SoCuoi As Long
Sheets("BCNX").Select
Range("A9:A10000").ClearContents
SoDau = Range("A8")
With Sheets("NKNX")
  endR = .Cells(65000, 2).End(xlUp).Row
  SoCuoi = .Cells(endR, 2).Value
End With
If SoCuoi < SoDau Then Exit Sub
endR = 8 + SoCuoi - SoDau
If endR = 8 Then
  Range("A" & 8 + SoCuoi - SoDau).Value = SoCuoi
  Range("B9:Y10000").ClearContents
  Exit Sub
Else
  Range("B9:Y10000").ClearContents
  Range("B9:Y" & endR - 1).Value = Range("B8:Y8").Value
End If
If SoCuoi - SoDau = 1 Then
  Range("A9") = SoCuoi
Else
  With Range("A9:A" & 8 + SoCuoi - SoDau - 1)
    .FormulaR1C1 = "=+R[-1]C+1"
    .Value = .Value
  End With
End If
 
End Sub
Nhấp chuột vào đây để mở rộng...

Tôi gởi file mới lên bạn xem và kiểm tra giùm nhé!
 
Lần chỉnh sửa cuối:
Upvote 0
Nhờ kiểm tra!

ThuNghi đã viết:
Bạn không nói kiểm tra cái gì cả, và cái hàm vlôkup trên khi lấy giá trị xong chuyển thành value cho nhẹ file.
Nhấp chuột vào đây để mở rộng...
Bạn thử nhập vào các số như mình nói thì kết quả ở 2 sheet sẽ khác nhau!
Theo như file mới gởi:
- Sheet BX là code cũ, giá trị nhập vào ở cell A8<=10 thì kết quả là đúng nhưng A8=11 or =12 (2 số cuối của sheet NK cột A) thì kết quả lại sai mất. Ngược lại với sheet NX:
- Sheet NX là code mới đây nhất, gt cell A8<=10 thì kết quả lại lấy tới 11 không có 12 còn A8=11;12 thì kết quả lại đúng.
Bạn vui lòng nhập thử xem sẽ hiểu ngay kết quả và chỉnh lại giúp tôi với.
Cám ơn nhiều.
Còn để value tôi thấy nó chuyển xuống các hàng dưới đều cùng 1 giá trị giống hàng 8 hơn nữa sheet NX chỉ lấy một số cột ở sheet NK nên để value tôi nghĩ e không lấy được! Theo tôi nghĩ để cho nhẹ file thì mỗi lần làm xong thì minh chỉ nhập giá trị lớn nhất và up một lần nữa cho nó xóa sạch cũng được bởi sheet NX xem như là kết quả báo cáo hàng ngày thôi. Nếu bạn có cách nào mà khi workbook close cell A8 giá trị lớn nhất cột A sheet NK và clear nội dung từ Row9 đến hết bổ sung giúp mình luôn nhé.
Chào thân ái!
 
Upvote 0
tanlahill đã viết:
Bạn thử nhập vào các số như mình nói thì kết quả ở 2 sheet sẽ khác nhau!
Theo như file mới gởi:
- Sheet BX là code cũ, giá trị nhập vào ở cell A8<=10 thì kết quả là đúng nhưng A8=11 or =12 (2 số cuối của sheet NK cột A) thì kết quả lại sai mất. Ngược lại với sheet NX:
- Sheet NX là code mới đây nhất, gt cell A8<=10 thì kết quả lại lấy tới 11 không có 12 còn A8=11;12 thì kết quả lại đúng.
Bạn vui lòng nhập thử xem sẽ hiểu ngay kết quả và chỉnh lại giúp tôi với.
Cám ơn nhiều.
Còn để value tôi thấy nó chuyển xuống các hàng dưới đều cùng 1 giá trị giống hàng 8 hơn nữa sheet NX chỉ lấy một số cột ở sheet NK nên để value tôi nghĩ e không lấy được! Theo tôi nghĩ để cho nhẹ file thì mỗi lần làm xong thì minh chỉ nhập giá trị lớn nhất và up một lần nữa cho nó xóa sạch cũng được bởi sheet NX xem như là kết quả báo cáo hàng ngày thôi. Nếu bạn có cách nào mà khi workbook close cell A8 giá trị lớn nhất cột A sheet NK và clear nội dung từ Row9 đến hết bổ sung giúp mình luôn nhé.
Chào thân ái!
Nhấp chuột vào đây để mở rộng...
Bạn dùng code sau thử. Sorry vì chưa test hết!
PHP: 
Sub UpNX()
Dim endR As Long, SoDau As Long, SoCuoi As Long
Sheets("NX").Select
Range("A9:A10000").ClearContents
SoDau = Range("A8")
With Sheets("NK")
  endR = .Cells(65000, 1).End(xlUp).Row
  SoCuoi = .Cells(endR, 1).Value
End With
If SoCuoi <= SoDau Then Exit Sub
endR = 8 + SoCuoi - SoDau

If SoCuoi - SoDau = 1 Then
  Range("A9") = SoCuoi
Else
  With Range("A9:A" & 8 + SoCuoi - SoDau)
    .FormulaR1C1 = "=+R[-1]C+1"
    .Value = .Value
  End With
End If

If endR = 8 Then
  Range("A" & 8 + SoCuoi - SoDau).Value = SoCuoi
  Range("B9:Y10000").ClearContents
  Exit Sub
Else
  Range("B9:Y10000").ClearContents
  Range("B8:Y8").Copy Range("B9:Y" & endR)
  Range("B9:Y" & endR).Value = Range("B9:Y" & endR).Value
End If
End Sub
 
Upvote 0
Rất tuyệt vời! Cám ơn.

ThuNghi đã viết:
Bạn dùng code sau thử. Sorry vì chưa test hết!
PHP: 
Sub UpNX()
Dim endR As Long, SoDau As Long, SoCuoi As Long
Sheets("NX").Select
Range("A9:A10000").ClearContents
SoDau = Range("A8")
With Sheets("NK")
  endR = .Cells(65000, 1).End(xlUp).Row
  SoCuoi = .Cells(endR, 1).Value
End With
If SoCuoi <= SoDau Then Exit Sub
endR = 8 + SoCuoi - SoDau
 
If SoCuoi - SoDau = 1 Then
  Range("A9") = SoCuoi
Else
  With Range("A9:A" & 8 + SoCuoi - SoDau)
    .FormulaR1C1 = "=+R[-1]C+1"
    .Value = .Value
  End With
End If
 
If endR = 8 Then
  Range("A" & 8 + SoCuoi - SoDau).Value = SoCuoi
  Range("B9:Y10000").ClearContents
  Exit Sub
Else
  Range("B9:Y10000").ClearContents
  Range("B8:Y8").Copy Range("B9:Y" & endR)
  Range("B9:Y" & endR).Value = Range("B9:Y" & endR).Value
End If
End Sub
Nhấp chuột vào đây để mở rộng...

:clap::clap::clap:Cám ơn bạn rất nhiều. Rất tuyệt vời! Chỉ một đoạn code nho nhỏ và 1 cái Click nhẹ nhàng đã phải tiết kiệm khá nhiều thời gian và đảm bảo an toàn dữ liệu nữa đó bạn!
Qua sự tận tình giúp đỡ của bạn mà tôi đã “phát minh” thêm một sub() cũng khá bổ ích! Tôi gởi file lên bạn xem và bổ sung thêm những gì còn là “râu ria” nhé!
À bạn, trong code có một dòng cần chỉnh lại như sau thì nó mới ClearContents hết trong mọi trường hợp chứ còn trường hợp A8=Max… thì nó không Clear.Contents Range("B9:U10000")!
<FONT face=Arial>
PHP: 
Range("A9:A10000").ClearContents (Code trên của bạn, dòng 4 trên xuống) sửa lại như sau
Range("A9:U10000").ClearContents !
 
Lần chỉnh sửa cuối:
Upvote 0
Máy cái copy này anh Thunghi còn nhiều cái hay lắm -=.,,. Cũng vì máy cái hay đó mà mình ghiền GPE --=0
 
Upvote 0
tanlahill đã viết:
:clap::clap::clap:Cám ơn bạn rất nhiều. Rất tuyệt vời! Chỉ một đoạn code nho nhỏ và 1 cái Click nhẹ nhàng đã phải tiết kiệm khá nhiều thời gian và đảm bảo an toàn dữ liệu nữa đó bạn!
Qua sự tận tình giúp đỡ của bạn mà tôi đã “phát minh” thêm một sub() cũng khá bổ ích! Tôi gởi file lên bạn xem và bổ sung thêm những gì còn là “râu ria” nhé!
À bạn, trong code có một dòng cần chỉnh lại như sau thì nó mới ClearContents hết trong mọi trường hợp chứ còn trường hợp A8=Max… thì nó không Clear.Contents Range("B9:U10000")!
<FONT face=Arial>
PHP: 
Range("A9:A10000").ClearContents (Code trên của bạn, dòng 4 trên xuống) sửa lại như sau
Range("A9:U10000").ClearContents !
Nhấp chuột vào đây để mở rộng...
Chưa hiểu yêu cầu của bạn là gì cả. Cụ thể hơn đi.
Bạn xem lại sub Footer nhé.
Dòng i = Range("a1").Value + 1
Và bỏ các câu lệnh sum ở cột 11, 12, 13, 14.
PHP: 
Sub Footer()
     Dim i As Long
     i = Range("a1").Value + 1
     Cells(i, 7).Value = "TOÅNG COÄNG:"
     Cells(i, 8).Value = "=counta(R8C8:R[-1]C) & R6C12"
'     Cells(i, 11).Value = "=Sum(R8C11:R[-1]C)"
'     Cells(i, 12).Value = "=Sum(R8C12:R[-1]C)"
'     Cells(i, 13).Value = "=Sum(R8C13:R[-1]C)"
'     Cells(i, 14).Value = "=Sum(R8C14:R[-1]C)"
     Cells(i, 16).Value = "=Sum(R8C16:R[-1]C)"
     Cells(i, 17).Value = "=Sum(R8C17:R[-1]C)"
     Cells(i, 18).Value = "=Sum(R8C18:R[-1]C)"
     Cells(i, 20).Value = "=Sum(R8C20:R[-1]C)"
     Cells(i + 2, 19).Value = "Quy Nhôn, ngaøy " & Format(Now(), "d") & " thaùng " & Format(Now(), "m") & " naêm " & Format(Now(), "yyyy")
     Cells(i + 3, 7).Value = "Ngöôøi laäp bieåu"
     Cells(i + 3, 19).Value = "Ngöôøi baùo caùo"
     Cells(i + 7, 7).Value = "Laøm sao ñeå code ñònh daïng giaù trò naøy ôû giöõa cell haû baïn ?"
     Cells(i + 7, 19).Value = "Traàn Thanh Taân"
'SetProtect
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn và xin hổ trợ thêm!

ThuNghi đã viết:
Chưa hiểu yêu cầu của bạn là gì cả. Cụ thể hơn đi.
Bạn xem lại sub Footer nhé.
Dòng i = Range("a1").Value + 1
Và bỏ các câu lệnh sum ở cột 11, 12, 13, 14.
PHP: 
Sub Footer()
     Dim i As Long
     i = Range("a1").Value + 1
     Cells(i, 7).Value = "TOÅNG COÄNG:"
     Cells(i, 8).Value = "=counta(R8C8:R[-1]C) & R6C12"
'     Cells(i, 11).Value = "=Sum(R8C11:R[-1]C)"
'     Cells(i, 12).Value = "=Sum(R8C12:R[-1]C)"
'     Cells(i, 13).Value = "=Sum(R8C13:R[-1]C)"
'     Cells(i, 14).Value = "=Sum(R8C14:R[-1]C)"
     Cells(i, 16).Value = "=Sum(R8C16:R[-1]C)"
     Cells(i, 17).Value = "=Sum(R8C17:R[-1]C)"
     Cells(i, 18).Value = "=Sum(R8C18:R[-1]C)"
     Cells(i, 20).Value = "=Sum(R8C20:R[-1]C)"
     Cells(i + 2, 19).Value = "Quy Nhôn, ngaøy " & Format(Now(), "d") & " thaùng " & Format(Now(), "m") & " naêm " & Format(Now(), "yyyy")
     Cells(i + 3, 7).Value = "Ngöôøi laäp bieåu"
     Cells(i + 3, 19).Value = "Ngöôøi baùo caùo"
     Cells(i + 7, 7).Value = "Laøm sao ñeå code ñònh daïng giaù trò naøy ôû giöõa cell haû baïn ?"
     Cells(i + 7, 19).Value = "Traàn Thanh Taân"
'SetProtect
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn rất nhiều. Bạn chịu phiền cho tôi học hỏi thêm một tí nữa nhé!
a) Theo như Sub footer()
1./ Hàng 4 trên xuống: Cells(i, 8).Value = "=counta(R8C8:R[-1]C) & R6C12"
Có KQ là 2Xe làm sao để thêm được ký tự trắng vào đoạn code để có là 2 Xe KQ chứ không phải thêm ký tự trắng vào trước chữ xe ở ô L6(R6C12) của sheet!NX như tôi đã làm?
2./ Hàng 4 dưới lên: Cells(i + 7, 7).Value = "Laøm sao ñeå code ñònh daïng giaù trò naøy ôû giöõa cell haû baïn ?"
Với dòng này, tôi chỉ có ý là làm sao để định dạng đoạn text trên nằm giữa cell bằng code mà không phải format ngay trên sheet?
b) Tôi muốn "Move or copy..." NK thành Data (với số liệu như file đã gởi). Giả sử tôi nhập thêm NK 5 dòng nữa rồi click button (button ở trên NK) thì có thể tạo được code copy chỉ 5 dòng đó sang dòng tiếp theo ở Data mà không phải copy toàn bộ được không? (Nghĩa là mỗi khi có cái gì mới ở NK thì copy sang Data còn cái cũ thì không được overwrite)
Nếu được những điều nào trên, xin bạn hoặc các thành viên giúp tôi với! Chân thành cám ơn.
 
Lần chỉnh sửa cuối:
Upvote 0
copy cell không liền kề

Tôi muốn copy sang cột khác thành các cell liền kề từ các cell không liền kề nhưng chung một cột và cách dòng bằng nhau. Ví dụ: copy cell D4, D8, D12, D16, D20. Xin các bạn ai biết chỉ dùm. Cảm ơn.
 
Upvote 0
tanlahill đã viết:
b) Tôi muốn "Move or copy..." NK thành Data (với số liệu như file đã gởi). Giả sử tôi nhập thêm NK 5 dòng nữa rồi click button (button ở trên NK) thì có thể tạo được code copy chỉ 5 dòng đó sang dòng tiếp theo ở Data mà không phải copy toàn bộ được không? (Nghĩa là mỗi khi có cái gì mới ở NK thì copy sang Data còn cái cũ thì không được overwrite)
Nếu được những điều nào trên, xin bạn hoặc các thành viên giúp tôi với! Chân thành cám ơn.
Nhấp chuột vào đây để mở rộng...
Sao không copy từ dòng 8 Sh NK sang Dòng 8 của sh Data luôn. Mà phải copy từ dòng 13.
PHP: 
Sub copyData()
Dim endR As Long, eRow As Long
With Sheets("NK")
  eRow = .Cells(65000, 1).End(xlUp).Row
End With
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  If eRow > endR Then
    .Range(.Cells(endR, 1), .Cells(eRow, 28)).Value = Sheets("NK").Range(Cells(endR, 1), Cells(eRow, 28)).Value
  End If
End With

End Sub
 
Upvote 0
dophuong đã viết:
Tôi muốn copy sang cột khác thành các cell liền kề từ các cell không liền kề nhưng chung một cột và cách dòng bằng nhau. Ví dụ: copy cell D4, D8, D12, D16, D20. Xin các bạn ai biết chỉ dùm. Cảm ơn.
Nhấp chuột vào đây để mở rộng...
Dùng hàm indirect thủ,ví dụ copy sang A1:A4 thì như sau:
=INDIRECT("D" &ROW()*4) copy xuống.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

minhquipk
  • Question Question
Cách nhận biết những ô đã bị thay đổi giá trị khi thay đổi giá trị dữ liệu ở những ô khác
Trả lời
3
Đọc
61
le_vis
L
V
  • Question Question
Tách số liệu từ bảng tính ngang theo điều kiện
Trả lời
9
Đọc
204
HieuCD
H
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
1
Đọc
44
hoangtuaotrang_hp_vn
H
HeSanbi
  • Đã giải quyết
LocalizeXL v1.72 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
63
Đọc
10K
125479980
125479980
H
Tìm kết quả trả về theo loại
Trả lời
9
Đọc
71
VetMini
V
LongHoang123
  • Question Question
Xin hướng dẫn: Cách tạo vùng in dựa trên dữ liệu của listbox bằng VBA!!!
Trả lời
4
Đọc
78
LongHoang123
LongHoang123
M
  • Question Question
"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel
2 3 4
Trả lời
63
Đọc
15K
SonBDND
S
Q
Hỏi về công thức dò giá
Trả lời
6
Đọc
177
thanthanhan0801
T
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
6
Đọc
326
nguyenhuong34
nguyenhuong34
ThanhPhongDN
hỏi về cách thay đổi giá trị một ô sau khi nhập một giá trị vào đó
Trả lời
7
Đọc
135
vietduc147258
V
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
34
Đọc
13K
hungbon7890
hungbon7890
A
  • Question Question
code vba chuyển chuỗi thành text
Trả lời
11
Đọc
2K
SonBDND
S
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
11
Đọc
304
HUONGHCKT
H
Tandattb
Xin cách Khắc phục lỗi "Path/File access error"
Trả lời
8
Đọc
286
Tandattb
Tandattb
ThanhPhongDN
Nhờ giúp đỡ về công thức trong google sheet
    • Cười
Trả lời
4
Đọc
83
thuytrangbp28
T
saobekhonglac
Tạo form vòng quay may mắn
    • Thích
2
Trả lời
35
Đọc
15K
VetMini
V
D
Thống kê dữ liệu theo điều kiện
Trả lời
5
Đọc
138
VetMini
V
noisy
Xin file tính chế độ chuyên cần
    • Cười
Trả lời
0
Đọc
41
noisy
noisy
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
3
Đọc
714
hvnhpro
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
2
Đọc
121
leonguyenz
leonguyenz
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom