Copy dữ liệu có điều kiện sang một sheet mới tự động (1 người xem)

[tranthuttc]

em có một bài toán lập trình VBA với file excel đính kèm như sau: mục đích: copy cột( 1.cột thời gian đầu tiên và 2. cột tương ứng tiếp theo sang 1 sheet mới và đặt tên sheet trùng tên cột thứ 2). mong mọi người giúp đỡ ạ
em cảm ơn!!!!

 

[Hai Lúa Miền Tây]

em có một bài toán lập trình VBA với file excel đính kèm như sau: mục đích: copy cột( 1.cột thời gian đầu tiên và 2. cột tương ứng tiếp theo sang 1 sheet mới và đặt tên sheet trùng tên cột thứ 2). mong mọi người giúp đỡ ạ
em cảm ơn!!!!

- Duyệt qua tiêu đề cột.
- Copy sheet data_VND ra sheet mới
- Đặt tên sheet mới.
- Xóa các cột không cần thiết.

 

[Ba Tê]

em có một bài toán lập trình VBA với file excel đính kèm như sau: mục đích: copy cột( 1.cột thời gian đầu tiên và 2. cột tương ứng tiếp theo sang 1 sheet mới và đặt tên sheet trùng tên cột thứ 2). mong mọi người giúp đỡ ạ
em cảm ơn!!!!

Tặng bạn 2 Sub này chạy thử nhé, hổng trúng thì thôi.

Sub GPEXYZ()
Application.ScreenUpdating = False
Dim Rng As Range, Col As Long, I As Long
With Sheets("data_VND")
    Col = .[A3].End(xlToRight).Column
    Set Rng = .Range(.[A3], .[A3].End(xlDown)).Resize(, Col)
End With
For I = 2 To Col
    Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet
        .[A3] = Rng(1, 1)
        .[B3] = Rng(1, I)
        .Columns("A:B").ColumnWidth = 25
        Rng.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=.Range("A3:B3"), Unique:=False
        .Name = .[B3].Value
    End With
Next I
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Xoá mần lại:

Sub XoaWs()
Application.DisplayAlerts = False
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "data_VND" Then Ws.Delete
Next Ws
Application.DisplayAlerts = True
End Sub

 

[Quang_Hải]

em có một bài toán lập trình VBA với file excel đính kèm như sau: mục đích: copy cột( 1.cột thời gian đầu tiên và 2. cột tương ứng tiếp theo sang 1 sheet mới và đặt tên sheet trùng tên cột thứ 2). mong mọi người giúp đỡ ạ
em cảm ơn!!!!

Thử code này xem sao

Sub abc()
Dim rng As Range, j&
Set rng = Sheet1.Range("A3", Sheet1.[A65536].End(3))
For j = 2 To Sheet1.[A3].End(2).Column
   Sheets.Add.Name = Sheet1.Cells(3, j)
   Union(rng, rng.Offset(, j - 1)).Copy [A3]
Next
End Sub