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

[tranphuson]

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]

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]

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]

- 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]

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]

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]

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)

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]

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

 

[giaiphap]

Ý 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]

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]

Đú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]

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]

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]

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.

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]

Sửa code lại thế này.

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]

Sửa code lại thế này.

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]

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

Sheets(Range("C2").Value)

bằng:

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

 

[tranphuson]

Thay

Sheets(Range("C2").Value)

bằng:

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]

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ê]

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.

 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