Copy Paste VBA loop

Question

У меня проблема при запуске моего макроса VBA, который я написал для переноса набора данных. Основная цель - взять этот набор данных подряд за строкой и перенести его, чтобы столбцы B: K были новыми строками.

Вот пример того, что я пытаюсь сделать:

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 

Как я могу получить цикл для создания новой строки для каждого сотрудника?

Answer 1

Мне стало скучно и придумал это для вас. * Должен * быть довольно быстрым и безболезненным, но может потребовать знания диапазонов перед рукой.

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 

Answer 2

Это должно дать вам идею:

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