Copy dữ liệu qua Sheet khác bằng VBA (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

tranphuson

Thành viên thường trực
Tham gia
14/8/09
Bài viết
268
Được thích
10
Giới tính
Nam
Vui lòng giúp mình copy dữ liệu từ Sheet "DATA" qua các Sheet khác

Copy dữ liệu từ Sheet "DATA" qua các Sheet "Shop" theo điều kiện chọn có dấu "x". Các cột "x" sẽ thay đổi theo yêu cầu đánh dấu trước khi copy qua Sheet "Shop"

Hoặc có thể thêm tùy chọn Sheet "Shop" trước khi copy

Xin cảm ơn
 

File đính kèm

Vui lòng giúp mình copy dữ liệu từ Sheet "DATA" qua các Sheet khác

Copy dữ liệu từ Sheet "DATA" qua các Sheet "Shop" theo điều kiện chọn có dấu "x". Các cột "x" sẽ thay đổi theo yêu cầu đánh dấu trước khi copy qua Sheet "Shop"

Hoặc có thể thêm tùy chọn Sheet "Shop" trước khi copy

Xin cảm ơn
Mô tả lại chi tiết hơn.
 
Mô tả lại chi tiết hơn.

- Yêu cầu 1: Copy dữ liệu từ Sheet "DATA" qua các Sheet "Shop" theo điều kiện chọn có dấu "x".

- Yêu cầu 2: Có thể dùng "UserForm" chọn Sheet "Shop" trước khi copy. Vì các dấu "x" sẽ thay đổi dữ liệu theo Sheet "Shop" cần muốn copy & paste

Cảm ơn
 

File đính kèm

- Yêu cầu 1: Copy dữ liệu từ Sheet "DATA" qua các Sheet "Shop" theo điều kiện chọn có dấu "x".

- Yêu cầu 2: Có thể dùng "UserForm" chọn Sheet "Shop" trước khi copy. Vì các dấu "x" sẽ thay đổi dữ liệu theo Sheet "Shop" cần muốn copy & paste

Cảm ơn
Tôi đâu thấy cột T đánh dấu "x" đâu mà tại sao sheet Shop 2 lại có vậy?
 
Vui lòng giúp mình copy dữ liệu từ Sheet "DATA" qua các Sheet khác

Copy dữ liệu từ Sheet "DATA" qua các Sheet "Shop" theo điều kiện chọn có dấu "x". Các cột "x" sẽ thay đổi theo yêu cầu đánh dấu trước khi copy qua Sheet "Shop"

Hoặc có thể thêm tùy chọn Sheet "Shop" trước khi copy

Xin cảm ơn

Tôi nghĩ yêu cầu của chủ thớt nên đổi "X" thành "shop 1" hoặc "shop 2" hoặc "shop 3"hoặc "shop 4" thì sẽ có tính logic hơn, chứ để nguyên vậy không ai biết khi nào thì copy sang Shop 1 khi nào copy sang Shop 2 ...
nếu có thể đổi yêu cầu như vậy thì tham khảo code dưới đây (VBA gà nên code hơn loằng ngoằng, rất mong các bác chỉ giáo thêm)
Mã:
Sub copy()

LC_Data = Sheets("DATA").Cells(4, Columns.Count).End(xlToLeft).Column
LR_Data = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To LC_Data
LC1 = Sheets("Shop 1").Cells(5, Columns.Count).End(xlToLeft).Column + 1
LR1 = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
LC2 = Sheets("Shop 2").Cells(5, Columns.Count).End(xlToLeft).Column + 1
LR2 = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
LC3 = Sheets("Shop 3").Cells(5, Columns.Count).End(xlToLeft).Column + 1
LR3 = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row
LC4 = Sheets("Shop 4").Cells(5, Columns.Count).End(xlToLeft).Column + 1
LR4 = Sheet5.Cells(Rows.Count, "A").End(xlUp).Row
    If Sheet1.Cells(3, j).Value = "Shop 1" Then
        Sheet1.Select
        Sheet1.Range(Cells(4, j), Cells(LR_Data, j)).copy
        Sheet2.Select
        Sheet2.Range(Cells(4, LC1), Cells(LR1, LC1)).PasteSpecial xlPasteAll
        Sheet1.Select
        Sheet1.Application.CutCopyMode = False
    End If
    If Sheet1.Cells(3, j).Value = "Shop 2" Then
        Sheet1.Select
        Sheet1.Range(Cells(4, j), Cells(LR_Data, j)).copy
        Sheet3.Select
        Sheet3.Range(Cells(4, LC2), Cells(LR2, LC2)).PasteSpecial xlPasteAll
        Sheet1.Select
        Sheet1.Application.CutCopyMode = False
    End If
    If Sheet1.Cells(3, j).Value = "Shop 2" Then
        Sheet1.Select
        Sheet1.Range(Cells(4, j), Cells(LR_Data, j)).copy
        Sheet4.Select
        Sheet4.Range(Cells(4, LC3), Cells(LR3, LC3)).PasteSpecial xlPasteAll
        Sheet1.Select
        Sheet1.Application.CutCopyMode = False
    End If
    If Sheet1.Cells(3, j).Value = "Shop 2" Then
        Sheet1.Select
        Sheet1.Range(Cells(4, j), Cells(LR_Data, j)).copy
        Sheet5.Select
        Sheet5.Range(Cells(4, LC4), Cells(LR4, LC4)).PasteSpecial xlPasteAll
        Sheet1.Select
        Sheet1.Application.CutCopyMode = False
    End If
Next j
End Sub
 

File đính kèm

Vậy khi nào mới copy qua shop 1 và khi nào mới copy qua shop 2.
Ý của mình là mỗi khi
Vậy khi nào mới copy qua shop 1 và khi nào mới copy qua shop 2.
Ý của mình là sao khi xử lý số liệu bên Sheet "DATA" xong thì copy qua Sheet "Shop 1". Sau khi copy xong thì xử lý số liệu tiếp ở Sheet "DATA" và đánh dấu "x" ở cột khác và copy vào Sheet "Shop 2".... Số liệu ở các Sheet "Shop" sẽ khác nhau sau khi mình tính toán ở Sheet "DATA"
Cảm ơn
 
Ý của mình là mỗi khi

Ý của mình là sao khi xử lý số liệu bên Sheet "DATA" xong thì copy qua Sheet "Shop 1". Sau khi copy xong thì xử lý số liệu tiếp ở Sheet "DATA" và đánh dấu "x" ở cột khác và copy vào Sheet "Shop 2".... Số liệu ở các Sheet "Shop" sẽ khác nhau sau khi mình tính toán ở Sheet "DATA"
Cảm ơn
Còn cái nửa là khi copy đến shop 4 rồi thì tới shop 5 (shop 5 chưa có thì làm thế nào? tạo ra hay sao...) hay quay lại shop 1
 
Vui lòng giúp mình copy dữ liệu từ Sheet "DATA" qua các Sheet khác

Copy dữ liệu từ Sheet "DATA" qua các Sheet "Shop" theo điều kiện chọn có dấu "x". Các cột "x" sẽ thay đổi theo yêu cầu đánh dấu trước khi copy qua Sheet "Shop"

Hoặc có thể thêm tùy chọn Sheet "Shop" trước khi copy

Xin cảm ơn
Tại sao không dựa vào dữ liệu gốc để làm cho thuận tiện mà lại đưa dữ liệu Copy từ PivotTable vậy.
 
Quá tuyệt. Nhưng cho mình hỏi thêm là các Sheet bên dưới sẽ tạo ra tương ứng với Cột C2 khi được Copy dữ liệu từ Sheet "DATA"

Ví dụ: Chọn Cột C2 "Shop 3" thì dữ liệu sẽ copy và tạo ra Shop 3 bên dưới...

Cảm ơn
 

File đính kèm

Quá tuyệt. Nhưng cho mình hỏi thêm là các Sheet bên dưới sẽ tạo ra tương ứng với Cột C2 khi được Copy dữ liệu từ Sheet "DATA"

Ví dụ: Chọn Cột C2 "Shop 3" thì dữ liệu sẽ copy và tạo ra Shop 3 bên dưới...

Cảm ơn
Sửa code lại thế này.
Mã:
Sub GPE()
    Dim i As Long, Rng As Range
    Dim Arr(), dArr(), j As Long, k As Long
    On Error Resume Next
    i = Sheet1.UsedRange.Columns.Count
    Set Rng = Range("A3", Cells(3, i)).SpecialCells(xlCellTypeConstants)
    If Rng Is Nothing Then Exit Sub
    Arr = Range("A3:X" & Sheet1.UsedRange.Rows.Count).Value
    ReDim dArr(1 To (UBound(Arr) - 1), 1 To Rng.Cells.Count)
    For i = 1 To UBound(Arr, 2)
        If Arr(1, i) = "x" Then
            k = k + 1
            For j = 2 To UBound(Arr)
                dArr(j - 1, k) = Arr(j, i)
            Next j
        End If
    Next i
    Sheets(Range("C2").Value).Cells.ClearContents
    Sheets(Range("C2").Value).Range("A5").Resize(UBound(dArr), UBound(dArr, 2)) = dArr
    MsgBox "Da copy xong!"
End Sub
 
Sửa code lại thế này.
Mã:
Sub GPE()
    Dim i As Long, Rng As Range
    Dim Arr(), dArr(), j As Long, k As Long
    On Error Resume Next
    i = Sheet1.UsedRange.Columns.Count
    Set Rng = Range("A3", Cells(3, i)).SpecialCells(xlCellTypeConstants)
    If Rng Is Nothing Then Exit Sub
    Arr = Range("A3:X" & Sheet1.UsedRange.Rows.Count).Value
    ReDim dArr(1 To (UBound(Arr) - 1), 1 To Rng.Cells.Count)
    For i = 1 To UBound(Arr, 2)
        If Arr(1, i) = "x" Then
            k = k + 1
            For j = 2 To UBound(Arr)
                dArr(j - 1, k) = Arr(j, i)
            Next j
        End If
    Next i
    Sheets(Range("C2").Value).Cells.ClearContents
    Sheets(Range("C2").Value).Range("A5").Resize(UBound(dArr), UBound(dArr, 2)) = dArr
    MsgBox "Da copy xong!"
End Sub

Cảm ơn Anh rất nhiều. Đúng như yêu cầu của mình
 
Sửa code lại thế này.
Mã:
Sub GPE()
    Dim i As Long, Rng As Range
    Dim Arr(), dArr(), j As Long, k As Long
    On Error Resume Next
    i = Sheet1.UsedRange.Columns.Count
    Set Rng = Range("A3", Cells(3, i)).SpecialCells(xlCellTypeConstants)
    If Rng Is Nothing Then Exit Sub
    Arr = Range("A3:X" & Sheet1.UsedRange.Rows.Count).Value
    ReDim dArr(1 To (UBound(Arr) - 1), 1 To Rng.Cells.Count)
    For i = 1 To UBound(Arr, 2)
        If Arr(1, i) = "x" Then
            k = k + 1
            For j = 2 To UBound(Arr)
                dArr(j - 1, k) = Arr(j, i)
            Next j
        End If
    Next i
    Sheets(Range("C2").Value).Cells.ClearContents
    Sheets(Range("C2").Value).Range("A5").Resize(UBound(dArr), UBound(dArr, 2)) = dArr
    MsgBox "Da copy xong!"
End Sub
Cho mình hỏi thêm nếu cột C2 chỉ là số không có chữ thì không Copy được
Ví dụ: C2 "1" thì nhấn Nút copy không thực hiện copy qua Sheet "1"

Xin cảm ơn lần nữa
 

File đính kèm

Cho mình hỏi thêm nếu cột C2 chỉ là số không có chữ thì không Copy được
Ví dụ: C2 "1" thì nhấn Nút copy không thực hiện copy qua Sheet "1"
Thay
PHP:
Sheets(Range("C2").Value)
bằng:
PHP:
Worksheets(CStr(Range("C2").Value))
'Hoặc:'
'Worksheets(Range("C2").Text)
 
ví dụ không copy qua sheet mới mà copy qua 1 sheet có định dạng sẵn thì thay đổi code như thế nào nhỉ
Bạn thử cho nó "thế này nhỉ" xem sao.
PHP:
 Public Sub GPE()
Dim  ShName As String, Rws As Long, Col As Long
With Sheets("DATA")
    ShName = .Range("C2").Value
    Rws = .Range("A1000000").End(xlUp).Row - 3
    Col = .Range("XFD4").End(xlToLeft).Column
    Sheets(ShName).Range("A4").Resize(Rws, Col).Value = .Range("A4").Resize(Rws, Col).Value
End With
End Sub
 
Bạn thử cho nó "thế này nhỉ" xem sao.
PHP:
 Public Sub GPE()
Dim  ShName As String, Rws As Long, Col As Long
With Sheets("DATA")
    ShName = .Range("C2").Value
    Rws = .Range("A1000000").End(xlUp).Row - 3
    Col = .Range("XFD4").End(xlToLeft).Column
    Sheets(ShName).Range("A4").Resize(Rws, Col).Value = .Range("A4").Resize(Rws, Col).Value
End With
End Sub
Anh bate giúp e viết code sao cho copy cột có đánh dấu x nhé. sheet DON HANG cho 5000 dòng nhé anh. Cảm ơn anh nhiều
 

File đính kèm

Anh bate giúp e viết code sao cho copy cột có đánh dấu x nhé. sheet DON HANG cho 5000 dòng nhé anh. Cảm ơn anh nhiều
Bài này thì có liên quan gì với bài hỏi trước?
Dữ liệu đơn giản như vậy thì xài tạm code này đi:
PHP:
Public Sub sGpe()
Sheets("GOP").Range("E6:H6").Resize(5000).Value = _
Sheets("DON HANG").Range("E8:H8").Resize(5000).Value
End Sub
Chú ý: Nick tôi không phải "bate".
 
Nhờ có chút mà đến giờ vẫn chưa nói rõ, x nào copy vào cột nào, tất cả có thể có bao nhiêu x.
Chắc tôi phải "chạy" kiểu hỏi "cà giựt, cà giựt" này rồi.
LẦn đầu mò mẫm, lạ lẫm nên anh thông cảm, ý đồ của em muốn là vì em có rất nhiều đơn hàng H-001, H-002, H-003 v.v... nên muốn tạo nút lệnh chọn vào đơn hàng nào thì sẽ copy vào sheet tạo sẵn để xem dc khối lượng và số thùng......cụ thể copy 1 đơn hàng có 4 cột, kích thước, tồn đầu, đơn hàng, và còn lại . Chọn vào đơn hàng nào thì sẽ đánh dấu x vào và bấm nút lệnh thôi anh ạ. Anh "Ba Tê" giúp em nhé ^^
 
LẦn đầu mò mẫm, lạ lẫm nên anh thông cảm, ý đồ của em muốn là vì em có rất nhiều đơn hàng H-001, H-002, H-003 v.v... nên muốn tạo nút lệnh chọn vào đơn hàng nào thì sẽ copy vào sheet tạo sẵn để xem dc khối lượng và số thùng......cụ thể copy 1 đơn hàng có 4 cột, kích thước, tồn đầu, đơn hàng, và còn lại . Chọn vào đơn hàng nào thì sẽ đánh dấu x vào và bấm nút lệnh thôi anh ạ. Anh "Ba Tê" giúp em nhé ^^
Nếu vậy thì tạo ô (F1), chọn đơn hàng nào thì lấy dữ liệu theo đơn hàng đó, đâu cần phải đánh dấu (7 cột luôn, các cột khác công thức lu bu không hiểu)
 

File đính kèm

Híc!
Hết bate, đến pate, rồi bây giờ là BA.
Muốn viết sao thì viết, thiệt là chẳng hiểu muốn gì đây.
Mới đầu là ba te, tức là xí xọn. (tiếng Việt)
Kế đó là pâté, tức là món ăn xịn của Tây. (tiếng Pháp)
Bây giờ là BA, tức là Bachelor of Arts / cử nhân (tiếng Anh)
 
Muốn tạo ấn tượng với anh BA, để lần sau anh nhớ mà giúp đỡ em nữa ạ!
Híc! Con tui năm nay gần 40, cháu ngoại 2 đứa, "tạo ấn tượng" chắc không cần đâu.
Nên tạo ấn tượng bằng câu văn, hình thức bài viết sao cho mọi người không cảm thấy "mắc ghét" vì "nạc mỡ lẫn lộn"(Hi, Dear, Thank, ACE, e, a, ah,... trong tiếng Việt)
Có mấy ký tự mà "làm biếng gõ", sao muốn người khác viết code hàng ngàn ký tự cho mình. (vì viết tắt là VBA bắt lỗi liền, may là anh Bill ra Msgbox rất lịch sự).
 
Lần chỉnh sửa cuối:

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

Back
Top Bottom