셀과 인접 셀을 복사하고 새 행으로 삽입하십시오. Excel VBA

Question

셀과 인접 셀을 행에 복사하고이 셀의 오른쪽에있는 모든 데이터가 복사 된 새 행으로 삽입하려고합니다. 위에. 마이닝 후에 내 데이터는 이렇게 보입니다.

과 같이 내 데이터를 얻으려고 노력 메신저 : 이 이미지를 위 한 기록하지만 본질적으로 이동하는 모든 사람과 새 행 원래 행의 해당 위치입니다. 각 행에는 약 5 명의 직원과 직책이 있습니다.

덕분에 단 2 COLS에 대한

EDIT 시도 코드입니다. 1 위치. 아이디어가 빈 행을 생성하고 바로 자동 채우기 나머지 데이터를 복사 한 후 5 명 각 행에 항상있는 경우

Sub TransposeInsertRows() 
    Dim rng As Range 
    Dim i As Long, j As Long, k As Long 
    Dim x As Long, y As Long 
    Set rng = Application.InputBox _ 
    (Prompt:="Range Selection...", _ 
    Title:="Enter the name col and pos col", Type:=8) 
    Application.ScreenUpdating = False 
    x = rng(1, 1).Column + 2 
    y = rng(1, rng.Columns.Count).Column 
    For i = rng(rng.Rows.Count, 1).Row To rng(1, 1).Row Step -1 
     If Cells(i, x) <> "" And Cells(i, x + 1) <> "" Then 
      k = Cells(i, x - 2).End(xlToRight).Column 
      If k > y Then k = y 
      For j = k To x + 1 Step -1 
       Cells(i + 1, 1).EntireRow.Insert 
       With Cells(i + 1, x - 2) 
        .Value = .Offset(-1, 0) 
        .Offset(0, 1) = .Offset(-1, 1) 
        .Offset(0, 2) = Cells(i, j) 
       End With 
       Cells(i, j).ClearContents 
      Next j 
     End If 
    Next i 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

다음이가이해야 할에서 작업 :

Sub foo() 
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row 
For i = 1 To LastRow 'loop through rows 
    For x = 1 To 10 Step 2 'loop through columns 
     LastRow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 'find the next free row on Sheet2 
     Sheet2.Cells(LastRow2, 1).Value = Sheet1.Cells(i, x).Value 'add Person Name to Sheet2 
     Sheet2.Cells(LastRow2, 2).Value = Sheet1.Cells(i, x + 1).Value 'add position to Sheet2 
     Sheet1.Range("K" & i & ":U" & i).Copy Destination:=Sheet2.Cells(LastRow2, 3) 'copy range from K to U to Sheet2 
    Next x 
Next i 
End Sub