300x250
1. 코드작성하기
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
Sub convert_data_tocolumn()
Dim COPYRANGE As Range
Dim pasteRANGE As Range
Dim i As Integer
Set COPYRANGE = Application.InputBox("변경시킬데이터 선택", Type:=8)
Set changeRANGE = Application.InputBox("변경된 데이터 한 셀 선택", Type:=8)
i = 0
Application.ScreenUpdating = False
For Each Rng In COPYRANGE.Rows
Rng.Copy
changeRANGE.Offset(i, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
i = i + Rng.Columns.Count
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
|
cs |
2. 결과
결과
3. 추가 코드 작성하기
1) 옆에 인덱스를 해주자. 1번이 3번씩 반복이므로, 111,222,333 이런식으로 인덱스해주자.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
Sub convert_data_tocolumn()
Dim COPYRANGE As Range
Dim pasteRANGE As Range
Dim i As Integer
Set COPYRANGE = Application.InputBox("변경시킬데이터 선택", Type:=8)
Set changeRANGE = Application.InputBox("변경된 데이터 한 셀 선택", Type:=8)
i = 0
p = 1
Application.ScreenUpdating = False
For Each Rng In COPYRANGE.Rows
Rng.Copy
changeRANGE.Offset(i, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
changeRANGE.Offset(i, -1).Value = p
changeRANGE.Offset(i + 1, -1).Value = p
changeRANGE.Offset(i + 2, -1).Value = p
i = i + Rng.Columns.Count
p = p + 1
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
|
cs |
4. 결과
300x250
'엑셀 > VBA' 카테고리의 다른 글
| VBA-DATA 조건으로 나머지 데이터값 가져오기 (0) | 2024.02.03 |
|---|---|
| VBA - 데이터 변경지점의 값을 정리하기/가져오기 (0) | 2024.02.03 |
| 엑셀 VBA/필터된 셀을 필터된 곳에 붙여넣기/보여지는 셀에만 붙여넣기 (1) | 2023.10.16 |
| 엑셀 VBA - 병합하고 가운데 맞추기. (0) | 2023.10.10 |
| 엑셀 VBA - 다른 시트 데이터 복사하기/범위 복사/정리하기 (0) | 2023.10.10 |