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

tranphuson · 20/8/18

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

giaiphap · 20/8/18

tranphuson đã viết:
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.

tranphuson · 20/8/18

giaiphap đã viết:
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

giaiphap · 20/8/18

tranphuson đã viết:
- 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?

tranphuson · 20/8/18

giaiphap đã viết:
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?

Thì đó là giả thuyết. Nếu copy qua Sheet "Shop 1" với các dấu "x" đó. Khi copy qua Sheet "Shop 2" thì sẽ chọn lại dấu "x" ở cột khác...

giaiphap · 20/8/18

tranphuson đã viết:
Thì đó là giả thuyết. Nếu copy qua Sheet "Shop 1" với các dấu "x" đó. Khi copy qua Sheet "Shop 2" thì sẽ chọn lại dấu "x" ở cột khác...

Vậy khi nào mới copy qua shop 1 và khi nào mới copy qua shop 2.

nguyenthuy13388 · 20/8/18

tranphuson đã viết:
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

tranphuson · 20/8/18

giaiphap đã viết:
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

giaiphap đã viết:
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

giaiphap · 20/8/18

tranphuson đã viết:
Ý 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

tranphuson · 20/8/18

giaiphap đã viết:
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

Đúng rồi, các Sheet "Shop" sẽ tạo thêm khoảng 24 Shop. Cảm ơn

giaiphap · 20/8/18

tranphuson đã viết:
Đúng rồi, các Sheet "Shop" sẽ tạo thêm khoảng 24 Shop. Cảm ơn

Bạn tự kiểm tra nhé.

be_09 · 20/8/18

tranphuson đã viết:
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.

tranphuson · 20/8/18

giaiphap đã viết:
Bạn tự kiểm tra nhé.

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

giaiphap · 20/8/18

tranphuson đã viết:
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

tranphuson · 20/8/18

giaiphap đã viết:

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

tranphuson · 20/8/18

giaiphap đã viết:

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

befaint · 21/8/18

tranphuson đã viết:
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)

tranphuson · 21/8/18

befaint đã viết:
Thay

PHP:

Sheets(Range("C2").Value)

bằng:

PHP:

Worksheets(CStr(Range("C2").Value)) 'Hoặc:' 'Worksheets(Range("C2").Text)

Cảm ơn bạn mình đã làm được rồi

babygirl_8990 · 16/4/19

tranphuson đã viết:
Cảm ơn bạn mình đã làm được rồi

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ỉ

Ba Tê · 16/4/19

babygirl_8990 đã viết:
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

babygirl_8990 · 16/4/19

Ba Tê đã viết:

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

Ba Tê · 16/4/19

babygirl_8990 đã viết:
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".

babygirl_8990 · 16/4/19

Ba Tê đã viết:
Public Sub sGpe() Sheets("GOP").Range("E6:H6").Resize(5000).Value = _ Sheets("DON HANG").Range("E8:H8").Resize(5000).Value End Sub

di chuyển dấu x dữ liệu sẽ copy theo chữ x á anh pate (^^)

Ba Tê · 16/4/19

babygirl_8990 đã viết:
di chuyển dấu x dữ liệu sẽ copy theo chữ x á anh pate (^^)

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.

babygirl_8990 · 17/4/19

Ba Tê đã viết:
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é ^^

Ba Tê · 17/4/19

babygirl_8990 đã viết:
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)

babygirl_8990 · 17/4/19

Ba Tê đã viết:
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)

Anh BA tài quá, cảm ơn anh nhiều ạ ^^

Ba Tê · 17/4/19

babygirl_8990 đã viết:
Anh BA tài quá, cảm ơn anh nhiều ạ ^^

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.

babygirl_8990 · 17/4/19

Ba Tê đã viết:
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.

Muốn tạo ấn tượng với anh BA, để lần sau anh nhớ mà giúp đỡ em nữa ạ!

VetMini · 17/4/19

Ba Tê đã viết:
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)

Ba Tê · 17/4/19

babygirl_8990 đã viết:
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ự).

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

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

Thành viên thường trực

File đính kèm

==(^o^)==

Thành viên thường trực

File đính kèm

==(^o^)==

Thành viên thường trực

==(^o^)==

Thành viên thường trực

File đính kèm

Thành viên thường trực

==(^o^)==

Thành viên thường trực

==(^o^)==

File đính kèm

Biên Hòa, Đồng Nai

Thành viên thường trực

File đính kèm

==(^o^)==

Thành viên thường trực

Thành viên thường trực

File đính kèm

|||||||||||||

Thành viên thường trực

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên mới

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên mới

Đang đi tìm hòn đá

Cạo Rồi Khỏi Gội

Thời gian đếm ngược.