Cần Giúp Hàm Range trong VBA

[tavantan376]

Chào mọi người mình có đoạn mã VBA như này muốn copy cả khối nhưng lại không được.

Sub test_1()
Dim i, lr, vitricantim, vitri1, vitri2 As Integer
Dim sohang As Variant
On Error GoTo loi
Columns("D:D").Delete Shift:=xlToLeft
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:B").ColumnWidth = 4
Columns("C:C").ColumnWidth = 4
Columns("D:D").ColumnWidth = 8
Columns("E:E").ColumnWidth = 4
Columns("F:F").ColumnWidth = 4
lr = Worksheets("SheetB").Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lr
sohang = Worksheets("SheetB").Range("A" & i)
vitricantim = WorksheetFunction.Match(sohang, Worksheets("SheetA").Range("A:A"), 0)
Worksheets("SheetA").Range(Cells(vitricantim, 2), Cells(vitricantim, 6)).Copy Worksheets("SheetB").Range("D" & i)
Next i
Exit Sub
loi:
MsgBox "Co loai sat khong co ten trong danh sach", vbCritical
End Sub

 

[Maika8008]

Trước Cells(vitricantim, 2), Cells(vitricantim, 6) đều phải chỉ rõ sheet nào, chứ không là VBA không hiểu.
Như code bạn thì phải viết là Sheets("SheetA").Range(Sheets("SheetA").Cells(vitricantim, 2), Sheets("SheetA").Cells(vitricantim, 6)).Copy

 

[VetMini]

Sửa chỗ này:
For i = 3 To lr
sohang = Worksheets("SheetB").Range("A" & i)
vitricantim = WorksheetFunction.Match(sohang, Worksheets("SheetA").Range("A:A"), 0)
Worksheets("SheetA").Range(Cells(vitricantim, 2), Cells(vitricantim, 6)).Copy Worksheets("SheetB").Range("D" & i)
Next i
thành:
Set sh1 = Worksheets("SheetB")
Set sh2 = Worksheets("SheetA")
Set rg1 = sh1.Range("A;A")
For i = 3 To lr
sohang = sh1.Range("A" & i)
vitricantim = WorksheetFunction.Match(sohang, rg1, 0)
sh2.Range(sh2.Cells(vitricantim, 2), sh2.Cells(vitricantim, 6)).Copy sh1.Range("D" & i)
Next i
Nếu không, sẽ phải gọi hàm tính Worksheets(...) tất cả lr -2 lần

Nếu muốn gọn hơn thì sửa thêm chỗ này:
Columns("B:F").ColumnWidth = 4
Columns("D").ColumnWidth = 8

 

[tavantan376]

Trước Cells(vitricantim, 2), Cells(vitricantim, 6) đều phải chỉ rõ sheet nào, chứ không là VBA không hiểu.
Như code bạn thì phải viết là Sheets("SheetA").Range(Sheets("SheetA").Cells(vitricantim, 2), Sheets("SheetA").Cells(vitricantim, 6)).Copy

Cảm ơn bạn nhiều nhé!

Bài đã được tự động gộp: 15/7/21

Sửa chỗ này:
For i = 3 To lr
sohang = Worksheets("SheetB").Range("A" & i)
vitricantim = WorksheetFunction.Match(sohang, Worksheets("SheetA").Range("A:A"), 0)
Worksheets("SheetA").Range(Cells(vitricantim, 2), Cells(vitricantim, 6)).Copy Worksheets("SheetB").Range("D" & i)
Next i
thành:
Set sh1 = Worksheets("SheetB")
Set sh2 = Worksheets("SheetA")
Set rg1 = sh1.Range("A;A")
For i = 3 To lr
sohang = sh1.Range("A" & i)
vitricantim = WorksheetFunction.Match(sohang, rg1, 0)
sh2.Range(sh2.Cells(vitricantim, 2), sh2.Cells(vitricantim, 6)).Copy sh1.Range("D" & i)
Next i
Nếu không, sẽ phải gọi hàm tính Worksheets(...) tất cả lr -2 lần

Nếu muốn gọn hơn thì sửa thêm chỗ này:
Columns("B:F").ColumnWidth = 4
Columns("D").ColumnWidth = 8

Cảm ơn bạn nhiều nhé!