すべての行を最初の共通行に移動

Question

私はこの従業員のためにすべての存在データを最初の行に移動したいので、下の図は私の言葉よりも大きく、VBAコードこれを行う？または私は

Answer 1

コード以下試してみてくださいを認識していないですExcelのトリックがあります。

Sub Demo() 
    Dim ws As Worksheet 
    Dim cel As Range, rng As Range 
    Dim lastRow As Long, lastCol As Long, i As Long 
    Dim fOccur As Long, lOccur As Long, colIndex As Long 
    Dim dict As Object, c1 
    Application.ScreenUpdating = False 

    Set ws = ThisWorkbook.Sheets("Sheet1") 'change Sheet1 to your data range 
    Set dict = CreateObject("Scripting.Dictionary") 

    With ws 
     lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'last row with data in Column A 
     lastCol = .Cells.Find(What:="*", _ 
         After:=.Range("A1"), _ 
         Lookat:=xlPart, _ 
         LookIn:=xlFormulas, _ 
         SearchOrder:=xlByColumns, _ 
         SearchDirection:=xlPrevious, _ 
         MatchCase:=False).Column  'last column with data in Sheet1 

     Set rng = .Range("A1:A" & lastRow)    'set range in Column A 
     c1 = .Range("A2:A" & lastRow) 
     For i = 1 To UBound(c1, 1)      'using dictionary to get uniques values from Column A 
      dict(c1(i, 1)) = 1 
     Next i 

     colIndex = 16  'colIndex+1 is column number where data will be displayed from 
     For Each k In dict.keys  'loopthrough all unique values in Column A 
      fOccur = Application.WorksheetFunction.Match(k, rng, 0) 'get row no. of first occurrence 
      lOccur = Application.WorksheetFunction.CountIf(rng, k) 'get row no. of last occurrence 
      lOccur = lOccur + fOccur - 1 

      'copy range from left to right 
      .Range(.Cells(fOccur, 1 + colIndex), .Cells(lOccur, lastCol + colIndex)).Value = .Range(.Cells(fOccur, 1), .Cells(lOccur, lastCol)).Value 
      'delete blanks in range at right 
      .Range(.Cells(fOccur, 1 + colIndex), .Cells(lOccur, lastCol + colIndex)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 'delte blank rows 
     Next k 
    End With 
    Application.ScreenUpdating = True 
End Sub 

Answer 2

以下をお試しください。範囲を移動する場所に合わせて、次のコードを修正することができます。

Dim oW As Worksheet: Set oW = ThisWorkbook.Worksheets("Sheet8") 

With oW.UsedRange 
    .Cut .Offset(0, .Columns.Count + 2) 
End With