Link dữ liệu các sheet

[Thien]

Hi ! All

Hiện tại mình đang dùng công thức để link dữ liệu giữa các sheet như sau:
- Mình có 2 sheet.
- Muốn cột A6:B100 ở Sheet 1 khi có dữ liệu nhập vào thì từ động sẽ được link sang cột B5:C100 ở sheet2.
- Muốn cột J6:L100 ở sheet 1 khi có dữ liệu nhập vào thì từ động sẽ được link sang cột D5:F100 ở sheet2.
- Muốn cột N6:N100 ở sheet 1 khi có dữ liệu nhập vào thì từ động sẽ được link sang cột G5:G100 ở sheet2.
- Muốn cột M6:M100 ở sheet 1 khi có dữ liệu nhập vào thì từ động sẽ được link sang cột H5:H100 ở sheet2.
(dữ liệu mang sang có thể link hoặc chỉ là number, nhưng phải chép sang cả cột)

Hy vọng các bạn giúp mình giải bài này bằng VBA để file của mình sẽ nhẹ hơn, mặc khác mình sẽ tận dụng code này vào việc khác.

Thân chào.

 

[nvson]

Bạn nhấn phải chuột vào Sheet1 chọn View code rồi thêm code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
    Case Is <= 2
        If Target.Row >= 6 Or Target.Row <= 100 Then Sheet2.Cells(Target.Row, Target.Column + 1) = Target.Value
    Case 10 To 12
        If Target.Row >= 6 Or Target.Row <= 100 Then Sheet2.Cells(Target.Row, Target.Column - 6) = Target.Value
    Case 13
        If Target.Row >= 6 Or Target.Row <= 100 Then Sheet2.Cells(Target.Row, Target.Column - 5) = Target.Value
    Case 14
        If Target.Row >= 6 Or Target.Row <= 100 Then Sheet2.Cells(Target.Row, Target.Column - 7) = Target.Value
End Select
End Sub

 

[SA_DQ]

Cách dùng phương thức Intersect:

Option Explicit
[b]Private Sub Worksheet_Change(ByVal Target As Range)[/b]
 Application.ScreenUpdating = False
 If Not Intersect(Range("A6:B100"), Target) Is Nothing Then
    Sheets("S2").Range("B5:C99").Value = Range("A6:B100").Value
 End If
  If Not Intersect(Range("J6:L100"), Target) Is Nothing Then
    Sheets("S2").Range("D5:F99").Value = Range("J6:L100").Value
 End If
 If Not Intersect(Range("N6:N100"), Target) Is Nothing Then Sheets("S2").Range("G5:G99").Value = Range("N6:N100").Value
 If Not Intersect(Range("M6:M100"), Target) Is Nothing Then Sheets("S2").Range("H5:H99").Value = Range("M6:M100").Value
[b]End Sub[/b]

Bạn nào muốn tìm hiểu sâu hơn về phương thức Intersect: Hãy chịu khó tìm trên diễn đàn này = phương thức tìm kiếm!

 

[Thien]

Hi ! nvson.

Code của bạn còn vướng ở chỗ các cột nào ở S1 đã cài công thức thì không thể tự động link sang S2


Hi! SA_DO

Code của bạn đã hoàn chỉnh, đã giúp mình giải quyết được yêu cầu công việc của mình.

Rất cảm ơn các bạn đã giúp mình.

Thân chào.

 

[Thien]

Dear all !

Anh macro trong excel ghi lại cho tôi như sau:

Sub Chepsolieu()
' Macro recorded 13/11/2006 by Thien

Sheets("NKC").Select
Range("A10:A4933").Select
Selection.Copy
Sheets("Nhatky").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("NKC").Select
Range("C10:C4933").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Nhatky").Select
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("NKC").Select
Range("D104933").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Nhatky").Select
Range("C8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("NKC").Select
Range("G10:H4933").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Nhatky").Select
Range("D8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("NKC").Select
Range("K10:K4933").Select
Range("K4933").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Nhatky").Select
Range("F8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Giúp tôi rút gọn cái marco này với.

Thân chào.

 

[SA_DQ]

Bạn cứ thế này thử xem nha:

[b]Sub CopyRng()[/b]

 Application.ScreenUpdating = False
 Sheets("S2").Select
 Range("B6:C10").Value = Sheets("S1").Range("A6:B10").Value
 Range("A5:A9").Value = Sheets("S1").Range("M6:M10").Value

[b]End Sub[/b]

Quan trọng ở đây là số hàng & số cột của ma trận nguồn & ma trận đích là như nhau!

 

[Thien]

[b]Sub CopyRng()[/b]

 Application.ScreenUpdating = False
 Sheets("S2").Select
 Range("B6:C10").Value = Sheets("S1").Range("A6:B10").Value
 Range("A5:A9").Value = Sheets("S1").Range("M6:M10").Value

[b]End Sub[/b]

Quan trọng ở đây là số hàng & số cột của ma trận nguồn & ma trận đích là như nhau!

Rất hay. Cảm ơn bạn rất nhiều.
Code này của bạn hay hơn đoạn code của bạn trước đó bạn chỉ mình dùng Intersect.

Cảm ơn nhiều.

Thân chào.

 

[oden]

Thu cai nay , ko dep ko an tien.

Private Sub worksheet_change(ByVal Target As Range)
Sheet2.Range("B1:C100").Value = Sheet1.Range("A1:B100").Value
End Sub

========

Lưu ý: Bạn nhớ Viết bài có dấu tiếng Việt nha.

Jenni