xử lý bài toán copy bằng vba

[vandohcm]

Nhờ các bác giúp e xử lý bài toán này bằng code. Nếu có thời gian mong bác giải thích giúp e về code ạ. em cảm ơn nhiều ạ. chi tiết ở file đính kèm ạ.

 

[ndu96081631]

Nhờ các bác giúp e xử lý bài toán này bằng code. Nếu có thời gian mong bác giải thích giúp e về code ạ. em cảm ơn nhiều ạ. chi tiết ở file đính kèm ạ.

Trong file bạn nói rằng:

EM MUỐN COPY NỘI DUNG TỪ SHEET CÓ TÊN MAU1 SANG SHEET CÓ TÊN LÀ MAU2 MÀ VẪN GIỮ NGUYÊN ĐỊNH DẠNG THEO MẪU

Tôi nghĩ bạn có thể dùng chức năng Move or copy để copy nguyên cả một sheet, như vậy thì mọi thứ sẽ y chang với gốc

 

[vandohcm]

Trong file bạn nói rằng:

Tôi nghĩ bạn có thể dùng chức năng Move or copy để copy nguyên cả một sheet, như vậy thì mọi thứ sẽ y chang với gốc

Dạ em cảm ơn ạ, chắc là em diễn đạt gây khó hiểu. em chỉ muốn làm cách nào để lấy nội dung từ sheet mau1 sang sheet mau 2.Vì 2 mẫu định dạng khác nhau nên e chỉ có cách làm copy nội dung từng ô 1 thôi ạ. Với dữ liệu nhiều thì sẽ mất nhiều thời gian ạ. mong bác có thể giúp e ạ

 

[ndu96081631]

Dạ em cảm ơn ạ, chắc là em diễn đạt gây khó hiểu. em chỉ muốn làm cách nào để lấy nội dung từ sheet mau1 sang sheet mau 2.Vì 2 mẫu định dạng khác nhau nên e chỉ có cách làm copy nội dung từng ô 1 thôi ạ. Với dữ liệu nhiều thì sẽ mất nhiều thời gian ạ. mong bác có thể giúp e ạ

Nếu bạn copy nội dung ở sheet1 rồi paste toàn bộ sang sheet2 thì có vấn đề gì? Tại sao phải copy từng ô?

 

[vandohcm]

Nếu bạn copy nội dung ở sheet1 rồi paste toàn bộ sang sheet2 thì có vấn đề gì? Tại sao phải copy từng ô?

dạ là vì sheet mẫu 1 và mẫu 2 là form mặc định chỉ được nhập dữ liệu vào thôi ạ không được thay đổi định dạng ạ

 

[Ba Tê]

dạ là vì sheet mẫu 1 và mẫu 2 là form mặc định chỉ được nhập dữ liệu vào thôi ạ không được thay đổi định dạng ạ

Mau1: mỗi STT là 1 dòng, Trong cột B có thể có ALT+Enter
Mau2: mỗi STT thành 2 dòng, cột A và cột C mỗi 2 dòng thì merge lại?

 

[vandohcm]

Mau1: mỗi STT là 1 dòng, Trong cột B có thể có ALT+Enter
Mau2: mỗi STT thành 2 dòng, cột A và cột C mỗi 2 dòng thì merge lại?

dạ đúng rồi ạ. do em diễn đạt gây khó hiểu ạ

 

[Ba Tê]

dạ đúng rồi ạ. do em diễn đạt gây khó hiểu ạ

Mỗi STT chuyển thành 2 dòng, đừng nói là có thể thành 3, hay 4, ... dòng nhé.

Option Explicit

Public Sub s_Gpe()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, K As Long, R As Long
    sArr = Sheets("MAU1").Range("A3", Sheets("MAU1").Range("A3").End(xlDown)).Resize(, 3).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 2, 1 To 3)
    For I = 1 To R
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 3) = sArr(I, 3)
        If InStr(sArr(I, 2), ChrW(10)) Then
            dArr(K, 2) = Split(sArr(I, 2), ChrW(10))(0)
            dArr(K + 1, 2) = Split(sArr(I, 2), ChrW(10))(1)
        Else
            dArr(K, 2) = sArr(I, 2)
        End If
        K = K + 1
    Next I
With Sheets("MAU2")
    .Range("A3").Resize(1000, 3).ClearContents
    .Range("A3").Resize(1000, 3).UnMerge
    .Range("A3").Resize(1000, 3).Borders.LineStyle = 0
    .Range("A3").Resize(K, 3) = dArr
    For I = 3 To K + 2 Step 2
        .Range("A" & I).Resize(2, 3).Borders.LineStyle = 1
        .Range("A" & I).Resize(2, 3).Borders.Weight = xlMedium
        .Range("A" & I).Resize(2, 3).Borders(xlInsideHorizontal).LineStyle = xlNone
        .Range("A" & I).Resize(2).Merge
        .Range("C" & I).Resize(2).Merge
    Next I
End With
Application.ScreenUpdating = True
End Sub

 

[vandohcm]

Mỗi STT chuyển thành 2 dòng, đừng nói là có thể thành 3, hay 4, ... dòng nhé.

Option Explicit

Public Sub s_Gpe()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, K As Long, R As Long
    sArr = Sheets("MAU1").Range("A3", Sheets("MAU1").Range("A3").End(xlDown)).Resize(, 3).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 2, 1 To 3)
    For I = 1 To R
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 3) = sArr(I, 3)
        If InStr(sArr(I, 2), ChrW(10)) Then
            dArr(K, 2) = Split(sArr(I, 2), ChrW(10))(0)
            dArr(K + 1, 2) = Split(sArr(I, 2), ChrW(10))(1)
        Else
            dArr(K, 2) = sArr(I, 2)
        End If
        K = K + 1
    Next I
With Sheets("MAU2")
    .Range("A3").Resize(1000, 3).ClearContents
    .Range("A3").Resize(1000, 3).UnMerge
    .Range("A3").Resize(1000, 3).Borders.LineStyle = 0
    .Range("A3").Resize(K, 3) = dArr
    For I = 3 To K + 2 Step 2
        .Range("A" & I).Resize(2, 3).Borders.LineStyle = 1
        .Range("A" & I).Resize(2, 3).Borders.Weight = xlMedium
        .Range("A" & I).Resize(2, 3).Borders(xlInsideHorizontal).LineStyle = xlNone
        .Range("A" & I).Resize(2).Merge
        .Range("C" & I).Resize(2).Merge
    Next I
End With
Application.ScreenUpdating = True
End Sub

Dạ em cảm ơn nhiều ạ...đúng như mong muốn ạ