Option Explicit
Sub GPE()
Dim Sh As Worksheet, dRng As Range, sRng As Range
Dim Col As Byte, Dg As Integer
Sheets("capability").Select
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> "capability" Then
Set sRng = Sh.[A79].End(xlToRight)
Col = sRng.CurrentRegion.Columns.Count
Set dRng = Range("iu7").End(xlToLeft).Offset(, 1)
sRng.Offset(, 1).Resize(2, Col).Copy
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
Next Sh
Application.CutCopyMode = False
End Sub
.
5 Sheet dữ liệu có 32*5=160 hàng trong khi đó Sheet capability có 159 hàng bạn tính sao đây?Bạn ơi, bạn có thể chỉnh sửa cái code này hộ mình được không ? Cảm ơn bạn.
Có mấy vấn đề như sau khi chạy code:
1. Nó copy dữ liệu ở tất cả các sheet có cùng cấu trúc và có dữ liệu nhưng mình lại chỉ muốn lấy dữ liệu ở 5 sheet có tên là Fontbody1, Roof, Side1, Side2, Side3 thôi.
2. Các dữ liệu copy được paste ra thành nhiều cột mà mình muốn khi click nút comman lần 1 thì cả tất cả dữ liệu được paste vào 1 cột. Nghĩa là dữ liệu copy được ở Frontbody1 được paste từ cột I7:J38, dữ liệu copy được ở Roof được paste từ cột I9:J70, dữ liệu copy được ở Side1 được paste từ cột I71:J102 ... cứ nối như vậy đến hết sheet Side3. Ấn nút comman lần 2 thì dữ liệu copy được ở Frontbody1 được paste từ cột K7:L38, dữ liệu copy được ở Roof được paste từ cột K9:L70, dữ liệu copy được ở Side1 được paste từ cột K71:L102 ... cứ nối như vậy đến hết sheet Side3. Cứ như vậy nếu click 12 lần nút comman thì dữ liệu sẽ được paste đến cột AE và AF.
Mong tin bạn sớm.
).
1. File bạn gửi khác gì file của mình đâu?Cảm ơn bạn, code này về cơ bản là ok rồi. Nhưng vẫn còn 1 chút vấn đề nữa cần chỉnh sửa. Bạn xem hoàn thiện nốt giúp mình nhé (làm phiền bạn quá
1. Nếu để đúng như file bạn up lên thì mình chạy code ok. Mình thêm 4 sheet nữa vào file, sau đó chạy code lần 1 xong thì nó báo lỗi (bạn thử sẽ thấy ngay). Mình lại chạy code lần 2 thì dữ liệu cũng sai luôn cả vị trí.
2. Còn về số dòng 159<>160 thì mình đã insert thêm nhưng mình muốn nếu dữ liệu ở 5 sheet kia là lỗi #NA thì để trống. Bạn xem file đính kèm mình đã chú thích rõ ràng rồi. Một lần nữa xin cảm ơn bạn.
Sub COPY()
Dim Sh As Worksheet, dRng As Range, sRng As Range
Dim Col As Byte, Dg As Integer, Cot As Double
Application.ScreenUpdating = False
Set dRng = Sheet2.Range("iu7").End(xlToLeft).Offset(, 1)
Cot = dRng.Column
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name = "Front body1" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
If Sh.Name = "Roof" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
If Sh.Name = "Side1" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
If Sh.Name = "Side2" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
If Sh.Name = "Side3" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
Next Sh
Application.CutCopyMode = False
Application.ScreenUpdating = True
End SubOption Explicit
Sub gpeCOPY()
Dim Sh As Worksheet, dRng As Range, sRng As Range
Dim Col As Byte, Dg As Integer, Cot As Double
Dim MyName As String
Application.ScreenUpdating = False
MyName = "Front body1RoofSide1Side2Side3"
Set dRng = Sheet2.Range("iu7").End(xlToLeft).Offset(, 1)
Cot = dRng.Column
For Each Sh In ThisWorkbook.Worksheets
If InStr(MyName, Sh.Name) Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
1 GoTo GPE
If Sh.Name = "Roof" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
If Sh.Name = "Side1" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
If Sh.Name = "Side2" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
If Sh.Name = "Side3" Then
Sh.Range("BX79:DC80").COPY
dRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Set dRng = Sheet2.Cells(165, Cot).End(xlUp).Offset(1)
End If
9 GPE:
Next Sh
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
): Em muốn thay đổi chữ CommanButton1 thành COPY thì làm cách nào vậy ? Cảm ơn bác nhiều.
