复制粘贴VBA循环

运行我编写的用于转置数据集的VBA宏时遇到问题。主要目标是逐行获取此数据集，并对其进行转置，使列B：K成为新行。复制粘贴VBA循环

这里是什么，我试图做一个样本：

http://i.imgur.com/4ywn17m.png

我已经写了下面的VBA，但所有它做的是基本上创造了新的工作表“影子行” ，这不是我想要的。

Sub LoopPaste() 

Dim i As Long 
Dim firstRow As Long 
Dim lastRow As Long 
Dim wb As Workbook 
Dim sheet1 As Worksheet 
Dim sheet2 As Worksheet 

Set wb = ThisWorkbook 
Set sheet1 = wb.Sheets("Sheet1") 
Set sheet2 = wb.Sheets("Sheet2") 

'Find the last row with data 
lastRow = sheet1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row 

'This is the beginning of the loop 
For i = firstRow To lastRow 

    'Copying Company 
    sheet2.Range("A" & i) = sheet1.Range("A" & i).Value 

    'Copying Employees 
    sheet2.Range("B" & i) = sheet1.Range("B" & i).Value 
    sheet2.Range("B" & 1 + i) = sheet1.Range("C" & i).Value 
    sheet2.Range("B" & 2 + i) = sheet1.Range("D" & i).Value 
    sheet2.Range("B" & 3 + i) = sheet1.Range("E" & i).Value 

Next i 

End Sub

我该如何获得循环为每位员工创建一个新行？

来源

2016-11-15 user7162412

你可以使用Range'的''的偏移（）'方法。要将行转换为列，反之亦然，来自源范围左上角的偏移量（i，j）处的某些内容需要从目标范围的左上角开始偏移（偏移量为j，i）。 – jsheeran

我同意@jsheeran这将是最简单的循环遍历列和使用ThisWorkbook.Cells（Sheet1.Rows.Count，1）.End（xlUp）.Offset（1，0）.Value = positionInLoop（i） –

如果您先存储在数组中，然后转储到工作表，则可获得酷点积分！：D –

我很无聊，为你想出了这个。 *应该*非常快速和无痛，但可能需要事先知道范围。

Private Sub this() 

    Dim a() As Variant 

    a = Application.Transpose(Worksheets(1).Range("a1:p1").Value) 

    ThisWorkbook.Sheets("Sheet1").Range("a1:p1").Value = vbNullString 

    ThisWorkbook.Sheets("Sheet1").Range("a1:a55").Value2 = a 

End Sub

来源

2016-11-15 15:21:22

这应该给你的想法：

Sub test() 
    Dim src As Range, c As Range, target As Range 
    Dim curRow As Long 
    Set src = Intersect(Sheet1.Range("A1").CurrentRegion, Sheet1.Range("A1").CurrentRegion.Offset(1, 0)) 
    Set target = Sheet2.Range("a1") 
    curRow = src.Cells(1, 1).Row 
    For Each c In src.Cells 
     If c <> "" Then 
      target = c.Value 
      If c.Column = 1 Then 
       Set target = target.Offset(0, 1) 'next column 
      Else 
       Set target = target.Offset(1, 0) 'next row 
      End If 
     Else 
      'back to col 1 
      If target.Column <> 1 Then Set target = target.Offset(0, -target.Column + 1) 
     End If 
    Next c 

End Sub

来源

2016-11-15 16:24:31

复制粘贴VBA循环

回答

相关问题