Cần giúp đỡ khi copy nhiều ô khác nhau sang sheet mới (1 người xem)

[moonsun1130]

Mong các bác giúp em code copy dữ liệu
Em có 3 sheet Form, TTKh, Qhe. em muốn khi em nhập dữ liệu vào các ô ở sheet Form sau đó bấm ghi thì dữ liệu sẽ được ghi vào các ô tương ứng bên sheet TTKH và sheet Qhe
cảm ơn các bác!

 

[moonsun1130]

không ai giúp tôi công việc khó khăn này à?

 

[MinhCong]

không ai giúp tôi công việc khó khăn này à?

Từ từ chứ Bạn. Bạn thử làm theo cách sau xem sao:

Private Sub CommandButton1_Click()
    With S2.Range("B65500").End(xlUp).Offset(1)
    .Value = S26.Range("D5")
    .Offset(, 1).Value = S26.Range("D6")
    .Offset(, 2).Value = S26.Range("K5")
    .Offset(, 3).Value = S26.Range("K6")
    .Offset(, 4).Value = S26.Range("R7")
    .Offset(, 5).Value = S26.Range("R8")
    .Offset(, 6).Value = S26.Range("R5")
    "Tương tự cho các mục khác, cứ offset(,..) nó ra 1 cột sau đó tìm giá trị bên sheet Form ở ô nào thì điền vào thôi"
    End With
End Sub

 

[moonsun1130]

Anh MinhCong ơi cho em hỏi ở phần Thông tin quan hệ em sửa code như dưới sao không thấy dữ liệu sang sang sheet QHệ nhỉ
With S3.Range("B65500").End(xlUp).Offset(1)
.Value = S26.Range("D24")
.Offset(, 1).Value = S26.Range("D24")
.Offset(, 2).Value = S26.Range("D25")
End With

 

[MinhCong]

Bạn xem lại Range("B65500").End(xlUp) nhé! Do cột B của Bạn có công thức đến B200 nên Range("B65500").End(xlUp).row nó sẽ là 201. Hãy xóa hết những công thức của cột B đi

 

[moonsun1130]

Anh MinhCong ơi cho em hỏi có lệnh nào viết ngắn gọn hơn không nếu em viết như dưới thì dài quá. Cảm ơn Anh rất nhiều

' ten mat hang 1
.Value = S26.Range("D51")
.Offset(, 1).Value = S26.Range("D52")
.Offset(, 2).Value = S26.Range("D53")
.Offset(, 3).Value = S26.Range("D54")
' ten mat hang 3
.Offset(, 6).Value = S26.Range("D55")
.Offset(, 7).Value = S26.Range("D56")
.Offset(, 8).Value = S26.Range("D57")
.Offset(, 9).Value = S26.Range("D58")
' ten mat hang 3
.Offset(, 12).Value = S26.Range("D59")
.Offset(, 13).Value = S26.Range("D60")
.Offset(, 14).Value = S26.Range("D61")
.Offset(, 15).Value = S26.Range("D62")
' ten mat hang 4
.................
...............

 

[viehoai]

Anh MinhCong ơi cho em hỏi có lệnh nào viết ngắn gọn hơn không nếu em viết như dưới thì dài quá. Cảm ơn Anh rất nhiều

' ten mat hang 1
.Value = S26.Range("D51")
.Offset(, 1).Value = S26.Range("D52")
.Offset(, 2).Value = S26.Range("D53")
.Offset(, 3).Value = S26.Range("D54")
' ten mat hang 3
.Offset(, 6).Value = S26.Range("D55")
.Offset(, 7).Value = S26.Range("D56")
.Offset(, 8).Value = S26.Range("D57")
.Offset(, 9).Value = S26.Range("D58")
' ten mat hang 3
.Offset(, 12).Value = S26.Range("D59")
.Offset(, 13).Value = S26.Range("D60")
.Offset(, 14).Value = S26.Range("D61")
.Offset(, 15).Value = S26.Range("D62")
' ten mat hang 4
.................
...............

Bạn có thể dùng vòng lập như sau được không nhé
For i=1 to 3
.Offset(, i).Value = S26.Range("D" & 51+i)
next
V.V..

 

[MinhCong]

Nếu muốn ngắn gọn hơn thì phải sắp xếp lại dữ liệu trong sheet Form (Tức sắp xếp sao cho từ cột C5:C18 thì tương đương với B1:N1 bên sheet TTKH sau đó dùng copy vùng dữ liệu từ D518 bên sheet Form -> paste special -> transpose qua sheet TTKH...) chẳng hạn.

 

[moonsun1130]

Em đã sắp xếp lại các dòng theo đúng thứ tự từ D5-D18 tương ứng với các cột bên sheet TTKH B2->O2

 

[moonsun1130]

Bạn có thể dùng vòng lập như sau được không nhé
For i=1 to 3
.Offset(, i).Value = S26.Range("D" & 51+i)
next
V.V..

'.Offset(, 1).Value = S26.Range("D6")
'.Offset(, 2).Value = S26.Range("D7")
'.Offset(, 3).Value = S26.Range("D8")
'.Offset(, 4).Value = S26.Range("D9")
'.Offset(, 5).Value = S26.Range("D10")
'.Offset(, 6).Value = S26.Range("D11")
'.Offset(, 7).Value = S26.Range("D12")
'.Offset(, 8).Value = S26.Range("D13")
'.Offset(, 9).Value = S26.Range("D14")
'.Offset(, 10).Value = S26.Range("D15")
'.Offset(, 11).Value = S26.Range("D16")
Nếu em thay code như đoạn dưới thì dữ liệu sẽ vào đúng từ D6 - D16
Dim i As Long
With S2.Range("B65500").End(xlUp).Offset(1)
.Value = S26.Range("D5")
For i = 1 To 12
.Offset(, i).Value = S26.Range("D" & 5 + i)
Next

Nếu thay code này cho đoạn từ K5 - K16 thì dữ liệu lại nhập sai vào ô D5
.Value = S26.Range("K5")
For i = 1 To 12
.Offset(, i).Value = S26.Range("K" & 5 + i)
Next

'.Offset(, 12).Value = S26.Range("K5")
'.Offset(, 13).Value = S26.Range("K6")
'.Offset(, 15).Value = S26.Range("K7")
'.Offset(, 16).Value = S26.Range("K8")
'.Offset(, 17).Value = S26.Range("K9")
'.Offset(, 18).Value = S26.Range("K10")
'.Offset(, 19).Value = S26.Range("K11")
'.Offset(, 20).Value = S26.Range("K12")
'.Offset(, 21).Value = S26.Range("K13")
'.Offset(, 22).Value = S26.Range("K14")
'.Offset(, 23).Value = S26.Range("K15")
'.Offset(, 24).Value = S26.Range("K16")

Anh MinhCong Sao em viết code như dưới mà dữ liệu ở ô D5 không nhập vào cột B tương ứng bên sheet TTKH anh nhỉ. Các sheet bên TTKH là sheet nhập
' ten mat hang 1
.Value = S26.Range("D5")
.Offset(, 1).Value = S26.Range("D5")
.Offset(, 2).Value = S26.Range("D6")
...........

 

[viehoai]

'.Offset(, 1).Value = S26.Range("D6")
Nếu em thay code như đoạn dưới thì dữ liệu sẽ vào đúng từ D6 - D16
Dim i As Long
With S2.Range("B65500").End(xlUp).Offset(1)
.Value = S26.Range("D5")
For i = 1 To 12
.Offset(, i).Value = S26.Range("D" & 5 + i)
Next

Nếu thay code này cho đoạn từ K5 - K16 thì dữ liệu lại nhập sai vào ô D5
.Value = S26.Range("K5")
For i = 1 To 12
.Offset(, i).Value = S26.Range("K" & 5 + i)
Next

Mình làm ví dụ bạn tham khảo thêm nhé

 

[MinhCong]

Em đã sắp xếp lại các dòng theo đúng thứ tự từ D5-D18 tương ứng với các cột bên sheet TTKH B2->O2
View attachment 58673

Tạo lại Form cho Bạn, có gì nghiên cứu tiếp. Không nên dùng mercell khi sử dụng VBA. Bạn xem file nhé! Bên sheet TTKH Tôi có xóa 1 số cột ẩn không cần thiết.

Private Sub CommandButton1_Click()
Dim enR1 As Long, enR2 As Long
Application.ScreenUpdating = False
enR1 = S2.Range("B65500").End(xlUp).Row + 1
enR2 = S3.Range("B65500").End(xlUp).Row + 1
    S26.Range("D5:D16").Copy
     S2.Range("B" & enR1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    S26.Range("H5:H16").Copy
     S2.Range("N" & enR1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    S26.Range("L5:L16").Copy
     S2.Range("Z" & enR1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Code cho sheet QHệ Bạn tự nghiên cứu tiếp nhé!

 

[moonsun1130]

Anh MinhCong và Anh(chị) VietHoai giúp em với nhé. Cảm ơn Anh (chị) nhiều nhiều http://www.giaiphapexcel.com/forum/...ệu-từ-các-sheet-khác-nhau&p=295050#post295050