Code copy cot thanh hang (2 người xem)

[tanthanh94]

Chào các Anh GPE
Em muốn copy dữ liêu cột từ sheet1 thành hàng sang sheet 2
Em thấy trên diễn đàn có code copy rất hay nhưng không biết sữa như thế nào
Còn đây là copy của Anh Quanghai1969

[COLOR=#0000cd]Private Sub CommandButton1_Click()[/COLOR]
[COLOR=#0000cd]Dim sArr(), dArr(), i As Long, j As Byte, n As Byte[/COLOR]
[COLOR=#0000cd]With Sheet1[/COLOR]
[COLOR=#0000cd]   sArr = .Range("A3", .[G65536].End(3)).Value[/COLOR]
[COLOR=#0000cd]   ReDim dArr(1 To UBound(sArr), 1 To 7)[/COLOR]
[COLOR=#0000cd]   For i = 1 To UBound(sArr, 1)[/COLOR]
[COLOR=#0000cd]      For j = 1 To 7[/COLOR]
[COLOR=#0000cd]         n = Choose(j, 5, 4, 2, 6, 7, 3, 1)[/COLOR]
[COLOR=#0000cd]         dArr(i, j) = sArr(i, n)[/COLOR]
[COLOR=#0000cd]      Next[/COLOR]
[COLOR=#0000cd]   Next[/COLOR]
[COLOR=#0000cd]   .[O65536].End(3)(2).Resize(i - 1, 7) = dArr[/COLOR]
[COLOR=#0000cd]End With[/COLOR]
[COLOR=#0000cd]End Sub
[/COLOR]

 

[Kiều Mạnh]

Chào các Anh GPE
Em muốn copy dữ liêu cột từ sheet1 thành hàng sang sheet 2
Em thấy trên diễn đàn có code copy rất hay nhưng không biết sữa như thế nào
Còn đây là copy của Anh Quanghai1969

[COLOR=#0000cd]Private Sub CommandButton1_Click()[/COLOR]
[COLOR=#0000cd]Dim sArr(), dArr(), i As Long, j As Byte, n As Byte[/COLOR]
[COLOR=#0000cd]With Sheet1[/COLOR]
[COLOR=#0000cd]   sArr = .Range("A3", .[G65536].End(3)).Value[/COLOR]
[COLOR=#0000cd]   ReDim dArr(1 To UBound(sArr), 1 To 7)[/COLOR]
[COLOR=#0000cd]   For i = 1 To UBound(sArr, 1)[/COLOR]
[COLOR=#0000cd]      For j = 1 To 7[/COLOR]
[COLOR=#0000cd]         n = Choose(j, 5, 4, 2, 6, 7, 3, 1)[/COLOR]
[COLOR=#0000cd]         dArr(i, j) = sArr(i, n)[/COLOR]
[COLOR=#0000cd]      Next[/COLOR]
[COLOR=#0000cd]   Next[/COLOR]
[COLOR=#0000cd]   .[O65536].End(3)(2).Resize(i - 1, 7) = dArr[/COLOR]
[COLOR=#0000cd]End With[/COLOR]
[COLOR=#0000cd]End Sub
[/COLOR]

code tren la copy paste đảo cột nối đuôi nhau...còn bạn muốn copy dữ liêu cột từ sheet1 thành hàng sang sheet 2 thi bạn úp file giả lập của bạn lên ghi rõ vùng cần copy và đích đến mình coi xem thế nào nếu được mình làm cho...nói chung chung vậy ko ai làm cho đâu

 

[Ba Tê]

Chào các Anh GPE
Em muốn copy dữ liêu cột từ sheet1 thành hàng sang sheet 2
Em thấy trên diễn đàn có code copy rất hay nhưng không biết sữa như thế nào
Còn đây là copy của Anh Quanghai1969

[COLOR=#0000cd]Private Sub CommandButton1_Click()[/COLOR]
[COLOR=#0000cd]Dim sArr(), dArr(), i As Long, j As Byte, n As Byte[/COLOR]
[COLOR=#0000cd]With Sheet1[/COLOR]
[COLOR=#0000cd]   sArr = .Range("A3", .[G65536].End(3)).Value[/COLOR]
[COLOR=#0000cd]   ReDim dArr(1 To UBound(sArr), 1 To 7)[/COLOR]
[COLOR=#0000cd]   For i = 1 To UBound(sArr, 1)[/COLOR]
[COLOR=#0000cd]      For j = 1 To 7[/COLOR]
[COLOR=#0000cd]         n = Choose(j, 5, 4, 2, 6, 7, 3, 1)[/COLOR]
[COLOR=#0000cd]         dArr(i, j) = sArr(i, n)[/COLOR]
[COLOR=#0000cd]      Next[/COLOR]
[COLOR=#0000cd]   Next[/COLOR]
[COLOR=#0000cd]   .[O65536].End(3)(2).Resize(i - 1, 7) = dArr[/COLOR]
[COLOR=#0000cd]End With[/COLOR]
[COLOR=#0000cd]End Sub
[/COLOR]

Nhập STT cột cần lấy trên dòng 1 sheet1
Copy, Paste Tranpose sang sheet2. Sort theo cột STT.
Record Macro, chỉnh lại chút, thì nó như vầy:

Public Sub GPE()
Dim R As Long, C As Long
With Sheet1
    R = .[A1].End(xlDown).Row
    C = .[A1].End(xlToRight).Column
    .[A1].Resize(R, C).Copy
End With
With Sheet2
    .[A5].PasteSpecial Paste:=xlPasteAll, Transpose:=True
    .[A5].Resize(C, R).Sort Key1:=.[A5]
End With
End Sub

Dễ hiểu, dễ chỉnh sửa.

 

[Quang_Hải]

Chào các Anh GPE
Em muốn copy dữ liêu cột từ sheet1 thành hàng sang sheet 2
Em thấy trên diễn đàn có code copy rất hay nhưng không biết sữa như thế nào
Còn đây là copy của Anh Quanghai1969

[COLOR=#0000cd]Private Sub CommandButton1_Click()[/COLOR]
[COLOR=#0000cd]Dim sArr(), dArr(), i As Long, j As Byte, n As Byte[/COLOR]
[COLOR=#0000cd]With Sheet1[/COLOR]
[COLOR=#0000cd]   sArr = .Range("A3", .[G65536].End(3)).Value[/COLOR]
[COLOR=#0000cd]   ReDim dArr(1 To UBound(sArr), 1 To 7)[/COLOR]
[COLOR=#0000cd]   For i = 1 To UBound(sArr, 1)[/COLOR]
[COLOR=#0000cd]      For j = 1 To 7[/COLOR]
[COLOR=#0000cd]         n = Choose(j, 5, 4, 2, 6, 7, 3, 1)[/COLOR]
[COLOR=#0000cd]         dArr(i, j) = sArr(i, n)[/COLOR]
[COLOR=#0000cd]      Next[/COLOR]
[COLOR=#0000cd]   Next[/COLOR]
[COLOR=#0000cd]   .[O65536].End(3)(2).Resize(i - 1, 7) = dArr[/COLOR]
[COLOR=#0000cd]End With[/COLOR]
[COLOR=#0000cd]End Sub
[/COLOR]

Bạn chú ý tiêu đề không dấu >>> Phạm nội quy.
............
Code trên lẽ ra chỉ cần vầy thôi. Có lẽ lúc đó nội công còn yếu quá

Private Sub CommandButton1_Click()
[A2:G1000].AdvancedFilter 2, , [O2:U2]
End Sub

 

[tanthanh94]

Nhập STT cột cần lấy trên dòng 1 sheet1
Copy, Paste Tranpose sang sheet2. Sort theo cột STT.
Record Macro, chỉnh lại chút, thì nó như vầy:

Public Sub GPE()
Dim R As Long, C As Long
With Sheet1
    R = .[A1].End(xlDown).Row
    C = .[A1].End(xlToRight).Column
    .[A1].Resize(R, C).Copy
End With
With Sheet2
    .[A5].PasteSpecial Paste:=xlPasteAll, Transpose:=True
    .[A5].Resize(C, R).Sort Key1:=.[A5]
End With
End Sub

Dễ hiểu, dễ chỉnh sửa.

Cám ơn anh Ba Tê nhiều

 

[Quang_Hải]

Cám ơn anh Ba Tê nhiều

Đây cũng là 1 cách

Sub MyTranspose()
Dim Nguon(), Dich()
Nguon = Sheet1.[A2].CurrentRegion.Value
Dich = Application.Transpose(Nguon)
Sheet2.[A2].Resize(UBound(Dich), UBound(Dich, 2)) = Dich
End Sub