엑셀VBA_스닙펫:열을 추가함과 동시에 셀 복사시키기

PasteRangeWithInsertRows.bas

'사용법
'이 모듈은 셀을 복사할 시트에 열 추가 -> 셀 붙여넣기 의 작업을 단순화 시킨다.
'PasteRangeWithInsertRows함수를 특정 단축키에 지정하고 사용하면 유용하다.
'<사용법 동영상 삽입예정>

'작성일 : 2012.08.22
'작성자 : 서재원
'설명 : 엑셀 VBA 매크로
' 범위 열을 복사한다.
' 열이 모자라면 그만큼 열을 추가한다.
Sub PasteRangeWithInsertRows()
	Dim copyRange As Range
	Set copyRange = selectedRanges("복사할 셀을 선택하세요.")
	Dim pasteRange As Range
	Set pasteRange = selectedRanges("붙여넣기 할 셀을 선택하세요. 아래로 신규 행을 삽입합니다.")
	'복사된 셀의 범위만큼 Row 추가
	Call InsertRows(copyRange, pasteRange.Offset(rowOffset:=1))
	'셀 복사
	Call copyRange.Copy
	'값만 대상 셀에 복사
	pasteRange.Offset(rowOffset:=1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
	Set copyRange = Nothing
	Set pasteRange = Nothing
End Sub


'작성일 : 2012.08.22
'작성자 : 서재원
'설명 : 범용 엑셀VBA 프로퍼티
' 유저로부터 셀 주소를 입력받는다
Public Property Get selectedRanges(ByVal message As String) As Range
	Set selectedRanges = Application.InputBox(Prompt:=message, Title:="Select the range", Type:=8)
End Property

'작성일 : 2012.08.22
'작성자 : 서재원
'설명 : 범용 엑셀VBA 함수
' 붙여넣기 할 Range만큼 Row를 Insert한다.
Sub InsertRows(ByVal copyRange As Range, ByVal pasteRange As Range)
	Dim rowAddress As String
	rowAddress = Trim(Str(pasteRange.Row)) & ":" & Trim(Str(pasteRange.Row + copyRange.Rows.Count - 1))
	pasteRange.Worksheet.Rows(rowAddress).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub