매크로를 사용하여 Excel에서 다음 행의 열 가져 오기

Question

열에서 다음 행으로 데이터를 놓으라는 제목이 필요합니다. 많은 연구 끝에 매크로를 사용하여이 작업을 수행 할 수 있다는 것을 알게되었고, 여기가 당신의 도움이 필요한 부분입니다.

내가해야 할 일의

예 :

내가 뭘 의미하는 것은 내가 4 열

A  B  C  D 
1 Data1 Data2 Data3 Data4 
2 Data5 Data6 Data7 Data8 

이 같은 다음 라인으로 이동하기 위해 모든 D 열 데이터 싶은와 엑셀 문서를 가지고있다 .

Sub Data1() 
' 
' Data1 Macro 
' 
' 
' 
    ActiveCell.Offset(1, 0).Range("A1:D1").Select 
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
    Selection.Cut 
    ActiveCell.Offset(1, -3).Range("A1").Select 
    ActiveSheet.Paste 
End Sub 

결과 :

A  B  C  
1 Data1 Data2 Data3 
2 Data4 // First Data of D column on below line moved on line 2 
3 Data5 Data6 Data7 
4 Data8 // Second Data of D column on below line moved on line 4. 

는 그래서 새로운 2 코드를 상기 제 D를 "2"에 라인을 추가하고 해부 할 붙여 매크로 기록이있다

많은 것은 많은 시간을 거쳐야하므로 루프가 실제로 필요합니다. 내가 예상대로 지금 작동 나던 얼마나 스피하지만

그게 전부를 당신의 도움을 필요로하는 곳에

여기에 루프하지만 스피 스택을 사용하여 시도하고있다. 데이터와 2 차 수정 (작동하지 않는) 코드의 많은

Dim x As Integer 

Sub Data1() 
' 
' Data1 Macro 
' 
' 
' 
    x = 1 


    Do While x <= 20 ' that i will change as how many columns i have. 
     ActiveCell.Offset(x, 0).Range("A1:D1").Select 
     Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 
     ActiveCell.Offset(x - 2, x + 2).Range("A1").Select 
     Selection.Cut 
     ActiveCell.Offset(x, x - 4).Range("A1").Select 
     ActiveSheet.Paste 

     x = x + 2 ' if it starts from cell no1 and we have a blank to fill with Data4 or Data8 of D row then we need x+2 i believe and not x+1. 
    Loop 
End Sub 

결과 : 사전에

감사합니다.

Answer 1

루프의 매개 변수가 루프가 실행될 때 행을 추가하여 복잡해 지지만이를 수행하는 가장 좋은 방법은 D의 모든 데이터를 통과하는 간단한 루프입니다. 이것은 do while 루프를 사용하고 카운터와 함께 점검 조건을 증가시킴으로써 해결됩니다.

Sub ConvertColDtoRow() 
'Note that this code is written specifically for column D, but it can be adjusted as needed by changing the column specified 

Dim Count As Long, LastRow As Long 
Count = 1 
LastRow = ActiveSheet.UsedRange.Rows.Count 
Do While Count <= LastRow 
    If Not IsEmpty(ActiveSheet.Cells(Count,4)) Then 
     Range(Cells(Count,4).Address).Offset(1,0).EntireRow.Insert 
     Cells(Count + 1,1).Value = Cells(Count,4).Value 
     Cells(Count,4).Value = "" 
     Count = Count + 2 
     LastRow = LastRow + 1 
    Else 
     Count = Count + 1 
    End If 
Loop 

End Sub