我需要帮助一些人,我对此非常感兴趣。我想复制一些数据行,如下图所示。 数据来源示例:
我想转置此数据并将其粘贴到另一张纸上,如下一个链接后的图片所示。这是期望的结果。 I filled this sheet manually.
困难的部分是每行粘贴到一列后,需要跳过一个列。这是我得到的代码。此代码会跳过它应该的列,但数据不会以正确的方式粘贴 - 正如您在下面的示例中所看到的。结果/粘贴表
的示例 我很坚持这个。谁知道我怎么解决这个问题?非常感谢帮助。Dim iLastRow As Integer
'vind laatste rij
iLastRow = ThisWorkbook.Sheets("Mappen_Outlook").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To iLastRow
'kopieer submap 3 vanuit mappen naar SLA
ThisWorkbook.Sheets("Mappen_Outlook").Range("D" & x & ":D" & x).Copy
ThisWorkbook.Sheets("SLA").Range("B2").End(xlUp).Offset(1, (x - 2) * 2).PasteSpecial xlPasteValues
'kopieer de oudste datum vanuit mappen naar SLA
ThisWorkbook.Sheets("Mappen_Outlook").Range("G" & x & ":G" & x).Copy
ThisWorkbook.Sheets("SLA").Range("B3").End(xlUp).Offset(1, (x - 2) * 2).PasteSpecial xlPasteValues
'kopieer de totaalmails vanuit mappen naar SLA
ThisWorkbook.Sheets("Mappen_Outlook").Range("E" & x & ":E" & x).Copy
ThisWorkbook.Sheets("SLA").Range("B4").End(xlUp).Offset(2, (x - 2) * 2).PasteSpecial xlPasteValues
'kopieer het aantal op SLA vanuit mappen naar SLA
ThisWorkbook.Sheets("Mappen_Outlook").Range("I" & x & ":I" & x).Copy
ThisWorkbook.Sheets("SLA").Range("B5").End(xlUp).Offset(3, (x - 2) * 2).PasteSpecial xlPasteValues
'kopieer het aantal buiten SLA vanuit mappen naar SLA
ThisWorkbook.Sheets("Mappen_Outlook").Range("J" & x & ":J" & x).Copy
ThisWorkbook.Sheets("SLA").Range("B6").End(xlUp).Offset(4, (x - 2) * 2).PasteSpecial xlPasteValues
Next x
答案 0 :(得分:1)
这是使用变体数组的方法。
Sub test()
Dim vDB, vR()
Dim Ws As Worksheet, toWs As Worksheet
Dim i As Long, n As Long
Set Ws = Sheets("Mappen_Outlook")
Set toWs = Sheets("SLA")
vDB = Ws.Range("a1").CurrentRegion
For i = 2 To UBound(vDB, 1)
n = n + 2
ReDim Preserve vR(1 To 8, 1 To n)
vR(1, 1) = vDB(1, 4)
vR(2, 1) = vDB(1, 7)
vR(4, 1) = vDB(1, 5)
vR(5, 1) = vDB(1, 9)
vR(8, 1) = vDB(1, 10)
vR(1, n) = vDB(i, 4)
vR(2, n) = vDB(i, 7)
vR(4, n) = vDB(i, 5)
vR(5, n) = vDB(i, 9)
vR(8, n) = vDB(i, 10)
Next i
With toWs
.Cells.Clear
.Range("a2").Resize(8, n) = vR
End With
End Sub
答案 1 :(得分:0)
使用End(xlUp)令人困惑。
只需替换
ThisWorkbook.Sheets("SLA").Range("B6").End(xlUp).Offset(4, (x - 2) * 2).PasteSpecial xlPasteValues
到
ThisWorkbook.Sheets("SLA").Range("B6").Offset(0, (x - 2) * 2).PasteSpecial xlPasteValues
等