Xin code tự động dán giá trị khi đến ngày định trước

[saobekhonglac]

Chào anh/chị.

Anh chị hướng dẫn giúp mình code sau cho khi đến ngày 30/4/2017 (hoặc ngày bất kỳ nào đó mình gõ vào) thì dữ liệu trong file excel sẽ tự động dán giá trị hết tất cả các sheet.

Cám ơn.

 

[Ai_Ma_Biet]

Gửi file lên đi bạn ơi.

 

[saobekhonglac]

Dán tất cả các sheet, các cột thì cũng cần gửi file nữa hả bạn,

Gửi file lên đi bạn ơi.

 

[befaint]

Dán tất cả các sheet, các cột thì cũng cần gửi file nữa hả bạn,

Sub ChapTatCa()
Dim D As Variant, ws As Worksheet
D = Sheet1.Range("A1")
If D <> Empty Then
    If IsDate(D) Then
        D = CLng(D)
        If D = CLng(Date) Then
            For Each ws In ThisWorkbook.Worksheets
                ws.UsedRange = ws.UsedRange.Value
            Next ws
        End If
    End If
End If
End Sub

 

[saobekhonglac]

A1 là nhập ngày cần dán giá trị hay sau vậy bạn. Mình làm thử nhưng không ra.

Sub ChapTatCa()
Dim D As Variant, ws As Worksheet
D = Sheet1.Range("A1")
If D <> Empty Then
    If IsDate(D) Then
        D = CLng(D)
        If D = CLng(Date) Then
            For Each ws In ThisWorkbook.Worksheets
                ws.UsedRange = ws.UsedRange.Value
            Next ws
        End If
    End If
End If
End Sub

 

[saobekhonglac]

Mình cần code khi mở file lên là tự động dán giá trị dữ liệu các sheet chứ không phải bấm nút thì nó mới dán nha bạn.

Sub ChapTatCa()
Dim D As Variant, ws As Worksheet
D = Sheet1.Range("A1")
If D <> Empty Then
    If IsDate(D) Then
        D = CLng(D)
        If D = CLng(Date) Then
            For Each ws In ThisWorkbook.Worksheets
                ws.UsedRange = ws.UsedRange.Value
            Next ws
        End If
    End If
End If
End Sub

 

[trung984]

Mình cần code khi mở file lên là tự động dán giá trị dữ liệu các sheet chứ không phải bấm nút thì nó mới dán nha bạn.

Thử thay.
Sub ChapTatCa()

Thành.
Private Sub Workbook_Open()

Rồi gán code vào ThisWorkbook.

 

[saobekhonglac]

Vẫn không được bạn ơi

Thử thay.
Sub ChapTatCa()

Thành.
Private Sub Workbook_Open()

Rồi gán code vào ThisWorkbook.

 

[ndu96081631]

Vẫn không được bạn ơi

Thứ nhất: Sự kiện Workbook_Open() thì cho vào Workbook chứ sao cho vào Sheet vậy đại ca?
Thứ hai: Phải sửa code thành vầy mới xong:

Private Sub Workbook_Open()
  Dim D As Variant, ws As Worksheet
  D = Sheet1.Range("A1").Value
  If IsDate(D) Then
    [COLOR=#ff0000]If CLng(D) <= Date Then[/COLOR]
      For Each ws In ThisWorkbook.Worksheets
        ws.UsedRange.Value = ws.UsedRange.Value
      Next ws
    End If
  End If
End Sub

 

[saobekhonglac]

Cũng không được luôn anh ơi.

Thứ nhất: Sự kiện Workbook_Open() thì cho vào Workbook chứ sao cho vào Sheet vậy đại ca?
Thứ hai: Phải sửa code thành vầy mới xong:

Private Sub Workbook_Open()
  Dim D As Variant, ws As Worksheet
  D = Sheet1.Range("A1").Value
  If IsDate(D) Then
    [COLOR=#ff0000]If CLng(D) <= Date Then[/COLOR]
      For Each ws In ThisWorkbook.Worksheets
        ws.UsedRange.Value = ws.UsedRange.Value
      Next ws
    End If
  End If
End Sub

 

[ndu96081631]

Cũng không được luôn anh ơi.

Với code tôi đưa lên diễn đàn, chẳng khi nào tôi viết "chay" mà không thử trước.
Vậy nếu có gì đó sai là lỗi từ phía bạn:
- Đặt code không đúng chỗ
- Bị "tranh chấp" với code sẵn có trên file của bạn
- vân vân.. và.. vân vân
-------------------
Muốn biết điều gì khiến cho nó "không được", chỉ có cách bạn gửi file thật lên đây. Còn không thì tôi... thua rồi đấy