Copy dữ liệu, chỉ paste lấy định dạng và giá trị (không lấy công thức) (1 người xem)

[tvl297]

các bạn giúp mình copy giá trị sang sheet CD nhe. Thank
http://www.mediafire.com/?cyjd8uv1qjx1g9g

 

[Luc Van]

các bạn giúp mình copy giá trị sang sheet CD nhe. Thank
http://www.mediafire.com/?cyjd8uv1qjx1g9g

Bạn hỏi chơi hay hỏi thiệt vậy. Mình chẳng biết copy cái giá trị gì nữa. Với lại nếu đơn giản chỉ là copy/ paste spciel thì đơn giản quá.

 

[leonguyenz]

Bạn hỏi chơi hay hỏi thiệt vậy. Mình chẳng biết copy cái giá trị gì nữa. Với lại nếu đơn giản chỉ là copy/ paste spciel thì đơn giản quá.

Box Lập trình.
Chắc là tạo nút coppy qua Sheet khác.
Tham khảo bài này: Tổng hợp từ nhiều sheet

 

[tvl297]

oạch, ý mình là ở sheets CD có code. mà code đó đang copy cả công thức của tất cả các sheet sang sheet CD. làm thế nào để nó copy giá trị của các sheet sang sheet CD.
code trong sheet CD:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Byte
Application.ScreenUpdating = False
Me.Move before:=Sheets(1)
[9:10000].Delete
For i = 2 To Sheets.Count
Sheets(i).[5:1000].Copy [A65536].End(xlUp).Offset(1)
Next
Application.ScreenUpdating = True
End Sub

 

[Hoàng Trọng Nghĩa]

oạch, ý mình là ở sheets CD có code. mà code đó đang copy cả công thức của tất cả các sheet sang sheet CD. làm thế nào để nó copy giá trị của các sheet sang sheet CD.
code trong sheet CD:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Byte
Application.ScreenUpdating = False
Me.Move before:=Sheets(1)
[9:10000].Delete
For i = 2 To Sheets.Count
Sheets(i).[5:1000].Copy [A65536].End(xlUp).Offset(1)
Next
Application.ScreenUpdating = True
End Sub

Hình như bạn muốn Paste tháng nào ra sheet của tháng đó hay paste tất cả sheet nào cũng như nhau?

 

[ndu96081631]

oạch, ý mình là ở sheets CD có code. mà code đó đang copy cả công thức của tất cả các sheet sang sheet CD. làm thế nào để nó copy giá trị của các sheet sang sheet CD.
code trong sheet CD:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Byte
Application.ScreenUpdating = False
Me.Move before:=Sheets(1)
[9:10000].Delete
For i = 2 To Sheets.Count
Sheets(i).[5:1000].Copy [A65536].End(xlUp).Offset(1)
Next
Application.ScreenUpdating = True
End Sub

Thì bạn sửa đoạn

Sheets(i).[5:1000].Copy [A65536].End(xlUp).Offset(1)

Thành

Sheets(i).[5:1000].Copy 
[A65536].End(xlUp).Offset(1).[COLOR=#ff0000]PasteSpecial 3[/COLOR]

 

[Ba Tê]

oạch, ý mình là ở sheets CD có code. mà code đó đang copy cả công thức của tất cả các sheet sang sheet CD. làm thế nào để nó copy giá trị của các sheet sang sheet CD.
code trong sheet CD:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Byte
Application.ScreenUpdating = False
Me.Move before:=Sheets(1)
[9:10000].Delete
For i = 2 To Sheets.Count
Sheets(i).[5:1000].Copy [A65536].End(xlUp).Offset(1)
Next
Application.ScreenUpdating = True
End Sub

Copy mấy cái màu mè, đậm lợt qua trước, sau đó chuyển tất cả thành giá trị sau.
Cuối code thêm vài dòng lệnh nữa

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Ws As Worksheet, Rng As Range
Sheets("CD").[A5:AZ10000].Clear
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "CD" Then
    Set Rng = Ws.Range(Ws.[A5], Ws.[A65000].End(xlUp)).Resize(, 50)
    Rng.Copy [A65000].End(xlUp).Offset(1)
End If
Next
    Set Rng = Range([A5], [A65000].End(xlUp)).Resize(, 50)
    Rng.Value = Rng.Value
Cancel = True
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

 

[Hoàng Trọng Nghĩa]

Thì bạn sửa đoạn

Sheets(i).[5:1000].Copy [A65536].End(xlUp).Offset(1)

Thành

Sheets(i).[5:1000].Copy 
[A65536].End(xlUp).Offset(1).[COLOR=#ff0000]PasteSpecial 3[/COLOR]

Ý của tác giả là như vầy: Copy định dạng, kể cả chiều cao của hàng ở mỗi sheet, sau đó chuyển giá trị thành value.

Để ý rằng tác giả này dùng sự kiện RightClick cho hoạt động này thật sự là quá bất tiện, cho nên em đã thay sự kiện này bằng nút lệnh, nó không ảnh hưởng đến những thứ khác.

Em viết code như sau:

Private Sub CommandButton1_Click()
      With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
                  
                  Dim i As Byte, r As Long
                  Sheets("CD").Rows("5:65536").Clear
                  For i = 1 To 3 ' Sheets.Count - 1
                        With Sheets("T" & i)
                              r = .Range("A65536").End(xlUp).Row
                              .Rows("5:" & r).Copy Sheets("CD") _
                              .Rows(Sheets("CD").[A65536].End(xlUp) _
                              .Offset(1).Row)
                        End With
                  Next
                  
                  With Sheets("CD")
                        r = .Range("A65536").End(xlUp).Row
                        With .Range("A5:AG" & r)
                              .Value = .Value
                        End With
                  End With
                  
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .ScreenUpdating = True
      End With
End Sub

 

[tvl297]

bác ndu ơi cháu làm như vậy nhưng nó ko copy cả định dạng sang

 

[tvl297]

các anh thử sử lý trên file gốc của em được ko. em thử rùi nhưng vẫn thấy ko ra.
http://www.mediafire.com/view/?881ribsab30k2v2

 

[tvl297]

Ý của tác giả là như vầy: Copy định dạng, kể cả chiều cao của hàng ở mỗi sheet, sau đó chuyển giá trị thành value.

Để ý rằng tác giả này dùng sự kiện RightClick cho hoạt động này thật sự là quá bất tiện, cho nên em đã thay sự kiện này bằng nút lệnh, nó không ảnh hưởng đến những thứ khác.

Em viết code như sau:

Private Sub CommandButton1_Click()
      With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
                  
                  Dim i As Byte, r As Long
                  Sheets("CD").Rows("5:65536").Clear
                  For i = 1 To 3 ' Sheets.Count - 1
                        With Sheets("T" & i)
                              r = .Range("A65536").End(xlUp).Row
                              .Rows("5:" & r).Copy Sheets("CD") _
                              .Rows(Sheets("CD").[A65536].End(xlUp) _
                              .Offset(1).Row)
                        End With
                  Next
                  
                  With Sheets("CD")
                        r = .Range("A65536").End(xlUp).Row
                        With .Range("A5:AG" & r)
                              .Value = .Value
                        End With
                  End With
                  
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .ScreenUpdating = True
      End With
End Sub

em làm được rùi cảm ơn rất nhiều

 

[tvl297]

Copy mấy cái màu mè, đậm lợt qua trước, sau đó chuyển tất cả thành giá trị sau.
Cuối code thêm vài dòng lệnh nữa

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Ws As Worksheet, Rng As Range
Sheets("CD").[A5:AZ10000].Clear
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "CD" Then
    Set Rng = Ws.Range(Ws.[A5], Ws.[A65000].End(xlUp)).Resize(, 50)
    Rng.Copy [A65000].End(xlUp).Offset(1)
End If
Next
    Set Rng = Range([A5], [A65000].End(xlUp)).Resize(, 50)
    Rng.Value = Rng.Value
Cancel = True
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

cảm ơn anh nhưng code của anh chỉ copy giá trị sau khi đã copy công thức từ các sheet sang anh à. như thế ở biểu của em vẫn bị lỗi