來自多個列的數據移動到空白行下面的Excel使用VBA宏

Question

我目前在以下格式的數據：

Name 1 | Email 1 | ID 1 | Address 1 Street | Address 1 Suburb | Address 1 City | Address 2 Street | Address 2 Suburb | Address 2 City | Address 3 Street | Address 3 Suburb | Address 3 City 
<NEW LINE> 
Name 2 | Email 2 | ID 2 | Address 1 Street | Address 1 Suburb | Address 1 City | Address 2 Street | Address 2 Suburb | Address 2 City 

等

，我需要它看起來像如下：

Name 1 | Email 1 | ID 1 | Address 1 Street | Address 1 Suburb | Address 1 City 
<NEW LINE> 
Name 1 | Email 1 | ID 1 | Address 2 Street | Address 2 Suburb | Address 2 City 
<NEW LINE> 
Name 1 | Email 1 | ID 1 | Address 3 Street | Address 3 Suburb | Address 3 City 
<NEW LINE> 
Name 2 | Email 2 | ID 2 | Address 1 Street | Address 1 Suburb | Address 1 City 
<NEW LINE> 
Name 2 | Email 2 | ID 2 | Address 2 Street | Address 2 Suburb | Address 2 City 

等

我至今在我的表格在列A是COUNTA公式WO找出我們需要在每行下方插入的行數，以便數據可以重複計算。從這我已經使用下面的代碼來插入這些行也工作正常。

Sub ProcessAddressLabels() 
For N = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 
    If Cells(N, 1) <> "" And Cells(N, 1) <> 1 Then 
      Rows(N + 1 & ":" & N + Cells(N, 1) - 1).Insert 
      NumValues = Cells(N, 1) 
    End If 
Next N 
End Sub 

我不確定從這裏是如何從最後複製每組3個單元格，並將它與重複的用戶數據一起放在下面的行中！

任何幫助非常感謝，我希望我解釋這一點就夠了！

Answer 1

試試這個：

Sub Test() 

    Dim rw As Range, n As Long, i As Long, x As Long 

    Set rw = ActiveSheet.Rows(1) 'starting row 

    Do While rw.Cells(1).Value <> "" 
     'how many sets of addresses to move? 
     x = Application.Ceiling((Application.CountA(rw) - 6)/3, 1) 
     If x > 0 Then 
      'insert required rows 
      rw.Offset(1, 0).Resize(x).Insert 
      For i = 1 To x 
       'copy common cells 
       rw.Cells(1).Resize(1, 3).Copy rw.Cells(1).Offset(i, 0) 
       'cut each address block 
       rw.Cells(7 + ((i - 1) * 3)).Resize(1, 3).Cut rw.Cells(1).Offset(i, 3) 
      Next i 
     End If 
     'move to next "new" row 
     Set rw = rw.Offset(1 + x, 0) 
    Loop 

End Sub 

Answer 2

我不能說我完全理解您的所有需求，但是 會是這樣的幫助：

Dim sht As Worksheet 
Set sht = ActiveSheet 
' copy the range C1:F1 to the start of the third row. 
sht.range("C1:F1").Copy Destination:=Worksheets("Sheet1").range("A3")