Copy một cột từ sheet này sang một cột các sheet khác bằng macro (1 người xem)

[light_light2204]

Chào các bạn!
Mình đang làm việc trên excel. Mình có 1 chút rối! Các bạn có thể giúp mình không?
Hiện tại mình cần macro có thể copy một cột từ sheet này sang một cột của các sheet khác.
Ví dụ: sheet abc - Cột I có 4 dòng dữ liệu:

COSM17757
COSM17757
COSM17757
COSM17757

Mình muốn copy toàn bộ dữ liệu cột I của abc 1 sang cột I của sheet acb và các sheet còn lại. Ví dụ sheet acb sẽ ra dữ liệu như sau:

COSM17757
COSM17757


Mình có khoảng 400 sheet cần dữ liệu như vậy. Các bạn giúp mình với nha. Mình đang rối vì sếp cứ hối Cám ơn các bạn nhiều lắm

Mình có đính kèm file của mình. File mẫu này chỉ có 4 sheet. File mình có 400 sheet lận

 

[hoamattroicoi]

Thử code này xem nhé, tự điều chỉnh tên sheet cho phù hợp nhé:

Sub Copy()
Sheets("Sheet 1").Range("A1:A4").copy Sheets("Sheet 2").[A1].Resize(8)
End Sub

 

[Quang_Hải]

Chào các bạn!
Mình đang làm việc trên excel. Mình có 1 chút rối! Các bạn có thể giúp mình không?
Hiện tại mình cần macro có thể copy một cột từ sheet này sang một cột của các sheet khác.
Ví dụ: sheet 1 - Cột A có 4 dòng dữ liệu:
bánh kem
sữa chua
Kẹo
Bánh mì

Mình muốn copy toàn bộ dữ liệu cột A của sheet 1 sang cột A của sheet 2. Vì sheet 2 có 8 dòng. Nên khi copy tự dộng sẽ ra dữ liệu như sau:
bánh kem
sữa chua
Kẹo
Bánh mì
bánh kem
sữa chua
Kẹo
Bánh mì

Mình có khoảng 400 sheet cần dữ liệu như vậy. Các bạn giúp mình với nha. Mình đang rối vì sếp cứ hối Cám ơn các bạn nhiều lắm

Chọn hết 400 sheet rồi copy dữ liệu từ cột A của sheet1 dán 1 nhát là 400 sheet có dữ liệu rồi. Mà lạ thật, mắc mớ gì cần tới 400 sheet chứ?
400 sheet trong cùng 1 file hay 400 sheet của 400 file? Hix. Nói chung là nên gởi file mẫu lên thì may ra nhé

 

[light_light2204]

Thử code này xem nhé, tự điều chỉnh tên sheet cho phù hợp nhé:

Sub Copy()
Sheets("Sheet 1").Range("A1:A4").copy Sheets("Sheet 2").[A1].Resize(8)
End Sub

Bạn ơi Mỗi sheet mình có 1 tên khác nhau. Nên nó báo lỗi. Mình cũng bối rối lắm. Không biết dữ liệu từ sheet 1 có copy cho hết cả 400 sheet không?

 

[light_light2204]

Chọn hết 400 sheet rồi copy dữ liệu từ cột A của sheet1 dán 1 nhát là 400 sheet có dữ liệu rồi. Mà lạ thật, mắc mớ gì cần tới 400 sheet chứ?
400 sheet trong cùng 1 file hay 400 sheet của 400 file? Hix. Nói chung là nên gởi file mẫu lên thì may ra nhé

Mình gửi bạn file mẫu. Hiện mình đang muốn copy dữ liệu từ cột I của sheet abc. Cho tất cả các cột I của các sheet trong cùng 1 file excel. File mẫu này chỉ có 4 sheet. File của mình trên 400 sheet lận
Chỉ cần copy được cột I2 của từng sheet sau đó fill tự động cũng được bạn

 

[hoamattroicoi]

Mình gửi bạn file mẫu. Hiện mình đang muốn copy dữ liệu từ cột I của sheet abc. Cho tất cả các cột I của các sheet trong cùng 1 file excel. File mẫu này chỉ có 4 sheet. File của mình trên 400 sheet lận
Chỉ cần copy được cột I2 của từng sheet sau đó fill tự động cũng được bạn

Hỏi 1 đằng, dữ liệu lên 1 kiểu, đâu liên quan gì đến 4 với 8 dòng đâu chứ, hix. Thấy cột I sheet abc dữ liệu giống nhau hết à, đều là "COSM17757", và bây giờ bạn muốn điền cái này vào tất cả các cột I của những sheet còn lại???
Trả lời đi rùi anh quanghai1969 sẽ giúp bạn viết code nhé, hehe

 

[Quang_Hải]

Mình gửi bạn file mẫu. Hiện mình đang muốn copy dữ liệu từ cột I của sheet abc. Cho tất cả các cột I của các sheet trong cùng 1 file excel. File mẫu này chỉ có 4 sheet. File của mình trên 400 sheet lận
Chỉ cần copy được cột I2 của từng sheet sau đó fill tự động cũng được bạn

May rủi nhé

Sub copykylaqua()
Dim sh As Worksheet, dk
dk = Sheets("abc").[I2].Value
For Each sh In Worksheets
   If sh.Name <> "abc" Then
      sh.Range(sh.[I2], sh.[H65536].End(3).Offset(, 1)).Value = dk
   End If
Next
End Sub

 

[light_light2204]

Hỏi 1 đằng, dữ liệu lên 1 kiểu, đâu liên quan gì đến 4 với 8 dòng đâu chứ, hix. Thấy cột I sheet abc dữ liệu giống nhau hết à, đều là "COSM17757", và bây giờ bạn muốn điền cái này vào tất cả các cột I của những sheet còn lại???
Trả lời đi rùi anh quanghai1969 sẽ giúp bạn viết code nhé, hehe

Đúng rồi bạn. Mình muốn điền tất cả COSM17757 vào trong cột I các sheet còn lại.
Cám ơn bạn. Mình đã chỉnh sửa lại các hỏi ở trên rồi.

 

[light_light2204]

May rủi nhé

Sub copykylaqua()
Dim sh As Worksheet, dk
dk = Sheets("abc").[I2].Value
For Each sh In Worksheets
   If sh.Name <> "abc" Then
      sh.Range(sh.[I2], sh.[H65536].End(3).Offset(, 1)).Value = dk
   End If
Next
End Sub

Em cám ơn anh nhiều lắm... Không biết phải nói thế nào. Anh có yahoo hay fb cho em xin để kết bạn

 

[Quang_Hải]

Em cám ơn anh nhiều lắm... Không biết phải nói thế nào. Anh có yahoo hay fb cho em xin để kết bạn

Ọc ọc mấy cái này chỉ là múa rìu qua mắt của mấy anh chị trên GPE thôi mà. Mình cũng như bạn thôi, copy của người khác rồi gởi lên thôi.

 

[light_light2204]

Dạ. Em cám ơn anh. Không nhờ có mấy anh trên GPE chắc em cũng vò đầu bứt tai rồi

 

[SA_DQ]

Đúng là không dễ để hiểu chủ topic muốn gì? Nhưng làm đại 1 fát

Option Explicit
Sub Copy()
Dim Sh As Worksheet, Rw As Long, Dg As Long

With Sheet1
 For Each Sh In ThisWorkbook.Worksheets
  If Sh.Name <> Sheet1.Name Then
   Rw = Sh.[B65500].End(xlUp).Row
   .Range([A1], [A1].End(xlDown)).Copy Destination:=Sh.[A1]
   Do
     Dg = Sh.[A65500].End(xlUp).Row
     If Dg > Rw Then
       Sh.Rows(Rw & ":" & Dg).Delete
       Exit Do
     End If
    .Range("A1:A4").Copy Sh.Cells(Dg + 1, "A")
   Loop
  End If
 Next Sh
End With
End Sub

 

[light_light2204]

Ọc ọc mấy cái này chỉ là múa rìu qua mắt của mấy anh chị trên GPE thôi mà. Mình cũng như bạn thôi, copy của người khác rồi gởi lên thôi.

Anh ơi Em lại gặp sự cố với bảng excel đó +___+ Hình như vẫn chưa giải quyết được hết vấn đề đó.

 

[light_light2204]

Option Explicit
Sub Copy()
Dim Sh As Worksheet, Rw As Long, Dg As Long

With Sheet1
 For Each Sh In ThisWorkbook.Worksheets
  If Sh.Name <> Sheet1.Name Then
   Rw = Sh.[B65500].End(xlUp).Row
   .Range([A1], [A1].End(xlDown)).Copy Destination:=Sh.[A1]
   Do
     Dg = Sh.[A65500].End(xlUp).Row
     If Dg > Rw Then
       Sh.Rows(Rw & ":" & Dg).Delete
       Exit Do
     End If
    .Range("A1:A4").Copy Sh.Cells(Dg + 1, "A")
   Loop
  End If
 Next Sh
End With
End Sub

Xin lỗi bạn! Do cách viết mình khó hiểu quá.
Bạn ơi! Hình như code không chạy được. Nó báo lỗi trên máy mình.