Copy từ Sheet nguyên dạng sang những Sheet có nhiều ô bị Merge nhưng vẫn giữ nguyên định dạng

[pingping2288]

Xin chào mọi người ạ! Em có 1 file như này, trong đó Sheet" File copy" có định dạng khác Sheet" Goc", xin hỏi có cách nào để Copy dữ liệu từ Sheet" Goc" sang Sheet" File copy " mà vẫn giữ nguyên định dạng của Sheet" File copy " không ạ?E xin cám ơn.

 

[pingping2288]

Xin chào mọi người ạ! Em có 1 file như này, trong đó Sheet" File copy" có định dạng khác Sheet" Goc", xin hỏi có cách nào để Copy dữ liệu từ Sheet" Goc" sang Sheet" File copy " mà vẫn giữ nguyên định dạng của Sheet" File copy " không ạ?E xin cám ơn.

Em xin giải thích tại sao phải làm như này là vì trong sheet mới của em có phần vẽ biểu đồ nằm giữa 2 ô, mình phải lấy dữ liệu từ ô bị merge luôn nên bắt buộc mình phải làm như vậy ạ!

 

[pingping2288]

Em xin giải thích tại sao phải làm như này là vì trong sheet mới của em có phần vẽ biểu đồ nằm giữa 2 ô, mình phải lấy dữ liệu từ ô bị merge luôn nên bắt buộc mình phải làm như vậy ạ!

Nghe hơi khó hay sao ấy ạ! Mong mọi người ra tay giúp em ạ!

 

[snow25]

Nghe hơi khó hay sao ấy ạ! Mong mọi người ra tay giúp em ạ!

Dùng vba không bạn.

 

[pingping2288]

Dùng vba không bạn.

Có ạ, miễn sao là được anh ạ, em cám ơn ạ?

 

[snow25]

Có ạ, miễn sao là được anh ạ, em cám ơn ạ?

Bạn thử cái sub này nhé.

Sub chuyendulieu()
Application.ScreenUpdating = False
    Dim arr, i As Long, lr As Long, j As Long, a As Long
    With Sheets("Goc")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A1:B" & lr).Value
    End With
    With Sheets("file copy")
         a = 1
         lr = .Range("A" & Rows.Count).End(xlUp).Row + 100
         .Range("A1:B" & lr).Clear
         For i = 1 To UBound(arr)
             If IsNumeric(arr(i, 1)) Then
                .Range("A" & a & ":A" & a + 2).Merge
                .Range("A" & a).Value = arr(i, 1)
                .Range("B" & a & ":B" & a + 2).Merge
                .Range("B" & a).Value = arr(i, 2)
                a = a + 3
             Else
                .Range("A" & a) = arr(i, 1)
                .Range("b" & a) = arr(i, 2)
                a = a + 1
             End If
         Next i
       With .Range("A1:B" & a)
             .Borders.LineStyle = 1
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
      End With
    End With
Application.ScreenUpdating = True
End Sub

 

[huuthang_bd]

Chọn B1:B166.
Nhập công thức sau rồi nhấn Ctrl + Enter.

=INDEX(Goc!$B$1:$B$60,COUNTA(A$1:A1))

Copy dán giá trị (nếu muốn).