請幫助，我需要一個 excel vba 代碼，它復制每一行的第二個值
并將其粘貼到另一張紙的列中
.
我試過這樣
Sub Test()
Worksheets("Sheet1").Activate
Dim x As Integer
For x = 5 To 196 Step 2
Worksheets("Tabelle1").Activate
Cells(x, 2).Value = Sheets("Sheets1").Range("E2:GN2")
Next x
End Sub
uj5u.com熱心網友回復：
你可以從這樣的事情開始：
Option Explicit
Private Sub dataCp()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = wb.Sheets("Tabelle1")
Dim lrow As Long, lcol As Long, i As Long
Dim rng As Range, c As Range
lcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For i = 5 To lcol
lrow = (ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row) 1
ws2.Range("D" & lrow).Value = ws.Cells(2, i).Value
i = i 1
Next
End Sub
uj5u.com熱心網友回復：
Sub test()
Dim WkSource As Worksheet
Dim WkDestiny As Worksheet
Dim i As Long
Dim j As Long
Dim LR As Long
Dim k As Long
Set WkSource = ThisWorkbook.Worksheets("Hoja1")
Set WkDestiny = ThisWorkbook.Worksheets("Hoja2")
With WkSource
LR = .Range("E" & .Rows.Count).End(xlUp).Row
k = 2 'starting row where you want to paste data in destiny sheet
For i = 2 To LR Step 1
For j = 5 To 12 Step 2 'j=5 to 12 because my data goes from column E to L (5 to 12)
WkDestiny.Range("D" & k).Value = .Cells(i, j).Value
k = k 1
Next j
Next i
End With
Set WkSource = Nothing
Set WkDestiny = Nothing
End Sub
代碼回圈遍歷每一行和每一列（注意第 2 步跳過列）
我得到的輸出：
uj5u.com熱心網友回復：
轉置資料
- 它將作業表中范圍的所有行轉換為另一個作業表上的連續列。
- 由于
scStepis2，在這種情況下，只會復制每個源行中的每個其他單元格。 - 調整（使用）常量部分中的值。
Option Explicit
Sub TransposeData()
' Source
Const sName As String = "Sheet1"
Const sFirstRowAddress As String = "E2:GN2"
Const scStep As Long = 2
' Destination
Const dName As String = "Tabelle1"
Const dFirstCellAddress As String = "D2"
' Both
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Write the values from the source range to the source array.
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim sData As Variant
Dim srCount As Long
With sws.Range(sFirstRowAddress)
' Populate data.
' With .Resize(20)
' .Formula = "=RANDBETWEEN(1,100)"
' .Value = .Value
' End With
Dim lCell As Range: Set lCell = .Resize(sws.Rows.Count - .Row 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data in data range
srCount = lCell.Row - .Row 1
sData = .Resize(srCount).Value
End With
' Define the destination array.
Dim scCount As Long: scCount = UBound(sData, 2)
Dim drCount As Long
drCount = Int(scCount / scStep) - CLng(scCount Mod scStep > 0)
Dim dData As Variant: ReDim dData(1 To drCount, 1 To srCount)
' Write the data from the source array to the destination array.
Dim r As Long, c As Long
For c = 1 To srCount
For r = 1 To drCount
dData(r, c) = sData(c, (r - 1) * scStep 1)
Next r
Next c
' Write the values from the destination array to the destination range.
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
With dws.Range(dFirstCellAddress).Resize(, srCount) ' first row range
' Write data.
.Resize(drCount).Value = dData
' Clear below.
.Resize(dws.Rows.Count - .Row - drCount 1).Offset(drCount).Clear
' Apply some formatting.
'.EntireColumn.AutoFit
End With
' Inform.
MsgBox "Data transposed.", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/447196.html