Trong VBA tạo vùng data gòm các cột không liên tục đẻ copy (1 người xem)

[manhhung12]

Chào các bạn
Tôi có ý thế này:
Để copy dữ liệu từ 1 sheet sang 1 sheet khác Tôi đã tạo 1 maccro mhư sau:

Sub m1()
    Dim khoi1 As Long
    Sheets("Sheet1").Select
    khoi1 = [b65432].End(xlUp).Row
    'Range("B3").Select
    'ActiveWindow.SmallScroll Down:=39
    Range("b3:c" & khoi1).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("a4").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
   
    Sheets("Sheet1").Select
    Range("E3").Select
    ActiveWindow.SmallScroll Down:=39
    Range("E3:E46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("H3").Select
    ActiveWindow.SmallScroll Down:=39
    Range("H3:H46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("E4").Select
End Sub

Thay vì dùng câu lệnh :
Range("....." & khoi1).Select
và câu lênh:
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

nhiều lần cho các vùng riêng lẻ; và phải mất công chuyển qua lai giữa 2 sheet. Ta có thể :
Bằng VBA: Tạo 1 vùng dữ liệu gồm các cột không liên tục (vùng dữ liệu động) đẻ copy sang 1 sheet khác đẻ tránh không dùng vòng lặp nhằm tăng tốc độ copy.
Mong các bạn giúp đỡ.

 

[ThuNghi]

Chào các bạn
Tôi có ý thế này:
Để copy dữ liệu từ 1 sheet sang 1 sheet khác Tôi đã tạo 1 maccro mhư sau:

Sub m1()
    Dim khoi1 As Long
    Sheets("Sheet1").Select
    khoi1 = [b65432].End(xlUp).Row
    'Range("B3").Select
    'ActiveWindow.SmallScroll Down:=39
    Range("b3:c" & khoi1).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("a4").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
   
    Sheets("Sheet1").Select
    Range("E3").Select
    ActiveWindow.SmallScroll Down:=39
    Range("E3:E46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("H3").Select
    ActiveWindow.SmallScroll Down:=39
    Range("H3:H46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("E4").Select
End Sub

Thay vì dùng câu lệnh :
Range("....." & khoi1).Select
và câu lênh:
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

.

Có phải bạn muốn copy và dán như sau"

Sheet2.Range("A4:A" & khoi1 +1).value=sheet1.Range("A3:A" & khoi1).value
Sheet2.Range("D447").value=sheet1.Range("H3:H46").value
Sheet2.Range("C4:C47").value=sheet1.Range("E3:E46").value

 

[manhhung12]

Có phải bạn muốn copy và dán như sau"

Làm vậy cũng gọn rồi nhưng tôi muốn có 1 vùng dữ liệu động (đinh nghĩa / gán tên cho nó) mà gộp được 3 vùng ( gồm b3:c46 ; e3:e46 và h3:h46) trên vào 1 vùng vì nó có cùng số dòng như nhau.

 

[ThuNghi]

Làm vậy cũng gọn rồi nhưng tôi muốn có 1 vùng dữ liệu động (đinh nghĩa / gán tên cho nó) mà gộp được 3 vùng ( gồm b3:c46 ; e3:e46 và h3:h46) trên vào 1 vùng vì nó có cùng số dòng như nhau.

Nếu như vậu sợ không ổn, đặt name gồm 3 vùng thì OK nhưng khi dán vào thì không hay. Và hình như bài này không cần VBA, theo tôi nên đặt 1 name 1