ACE giúp mình copy dữ liệu với (1 người xem)

[hoanghoa_dtt91]

Giờ mình muốn copy dữ liệu từ một cột Sheet1 (VD A1:A10) sang 2 dòng bên Sheet2 (VD A1:E1 và A2:E2), dùng code VBS giúp mình với. Thak!

 

[thanhsangnguyen1982]

Tốt nhất bạn gửi file chính thức lên đi.
Với yêu cầu của bạn thì mình gửi bạn code này
Nhấn ALT F11 copy code này vào sheet 1
Option Explicit
Sub Copydk()
Dim i, j, k As Long
With Sheet2
.Range("A1:E" & .Range("E65000").End(xlUp).Row).ClearContents
End With
i = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65000").End(xlUp).Row))
j = i / 2
k = j + 1
Range("A1:A" & j).Copy
With Sheet2
.Range("A1").PasteSpecial xlPasteValues, , , Transpose:=True
End With
Range("A" & k).Resize(i, 1).Copy
With Sheet2
.Range("A2").PasteSpecial xlPasteValues, , , Transpose:=True
End With
Range("A1").Select
Application.CutCopyMode = False
End Sub

 

[hoanghoa_dtt91]

Bạn xem giúp mình với, mình muốn chuyển cột dữ liệu sang thành một bảng. Thank!

 

[VetMini]

Code: Muốn sửa gì thì sửa trong vòng 5 cái trị constants ở đầu sub.

Sub t()

' This sub copies a column from a sheet
' divides the data evenly into a number of rows and writes to another sheet
' if the number rows does not divide the number of source cells
' the remainder will be distributed to the first r rows.

' all parameters are given in constants
' modify them to suit your need.

Const SHEETSRC = "Sheet1"
Const SHEETDES = "Sheet2"
Const RANGESRC = "A1:A10" ' the dataset to be copied
Const RANGEDES = "A1" ' first cell of destination
Const NUMROWSDES = 2

Dim rgSrc As Range, rgDes As Range

Set rgSrc = Sheets(SHEETSRC).Range(RANGESRC)
Set rgDes = Sheets(SHEETDES).Range(RANGEDES)

Dim numCols As Integer, numColsRem As Integer
Dim rw As Integer

' this section calculates the number of columns for each row
' if the number does not divide, distribution will favour the first rows
numCols = rgSrc.Rows.Count \ NUMROWSDES
numColsRem = rgSrc.Rows.Count Mod NUMROWSDES
If numColsRem > 0 Then numCols = numCols + 1 ' number does not divide, add extra column

For rw = 0 To NUMROWSDES - 1
    rgDes.Offset(rw).Resize(1, numCols) = Application.Transpose(rgSrc.Resize(numCols, 1))
    Set rgSrc = rgSrc.Offset(numCols)
    If numColsRem > 0 Then
        numColsRem = numColsRem - 1 ' subtract 1 from remainder
        If numColsRem = 0 Then numCols = numCols - 1 ' remainder has been fully distributed
    End If
Next rw

End Sub

 

[hoanghoa_dtt91]

Cho mình hỏi nếu muốn paste thành 2 dòng không tiếp nhau thì làm sao được (vd 1 dòng A1:E1 và 1 dòng A4:E4 chẳng hạn.)

 

[VetMini]

Thêm 1 cái const thứ 6

Const ROWDESSTEP = 3 ' sổ 3 có nghĩa là A4 - A1 = 3 dòng

Và sửa dòng này

For rw = 0 To NUMROWSDES - 1

Thành

For rw = 0 To (NUMROWSDES - 1) * ROWDESSTEP Step ROWDESSTEP