やること
VBAにて、パラメータシートから取得した転記情報を使用し、ワークブック間で転記を行う関数を作成します。
転記方法について
Paste／PasteSpecial
セルB1:B3の内容をセルD1に貼り付ける場合、転記方法は下記の(1)と(2)の方法があります。
Range("B1:B3").Copy '対象範囲をコピー
Range("D1").Select '貼り付け先を選択
ActiveSheet.Paste 'アクティブシートに貼り付け（セルD1）
Range("B1:B3").Copy '対象範囲をコピー
Range("D1").PasteSpecial '指定セルに貼り付け
実行結果は(1)と(2)それぞれ同じで、書式や数式を含む全貼付けされます。
異なる点
(1)ではPasteメソッド、(2)ではPasteSpecialメソッドを使用しています。
また、RangeオブジェクトにはPasteメソッドが無いため、下記のコードではエラーとなります。
Rangeオブジェクトを使用する時はPasteSpecialメソッドである必要があります。（Cellsも同様）
Range("B1:B3").Copy
Range("D1").Paste
PasteSpecialメソッドについて
PasteSpecialメソッドでは、先程のように何も指定しないと全貼付けになります。
任意オプションを指定することで、貼り付ける際の細かい操作が可能です。
（形式を選択して貼り付け（Ctrl + Alt + V）のようなもの）
オプションについて
・Paste：貼り付け形式の指定（参照：XlPasteType）
| 名称 | 値 | 説明 |
|---|---|---|
| xlPasteAll | -4104 | すべて貼り付け |
| xlPasteFormats | -4122 | 書式を貼り付け |
| xlPasteFormulas | -4123 | 数式を貼り付け |
| xlPasteValues | -4163 | 値のみ貼り付け |
xlPasteValues（-4163）と指定した場合の結果
・Operation：貼り付け対象セルに対して、コピーした値と演算する場合に指定。
・SkipBlanks：コピー範囲に含まれる空白セルを貼り付けずにスキップする場合、Trueを指定。
・Transpose：貼り付ける際、行と列を入れ替える場合はTrueを指定。
同ブック、別シート間での転記
コピー時、貼付け時はワークブックオブジェクトを指定しない場合、アクティブシートを操作対象とします。
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Set wks1 = ThisWorkbook.Worksheets("test1")
Set wks2 = ThisWorkbook.Worksheets("test2")
wks1.Range("B1:B3").Copy
wks2.Range("A1").PasteSpecial
サンプル
関数_fncCopyAndPaste
パラメータシートの内容を配列に格納したものを使用し、関数にしました。
受け取ったワークシートオブジェクト間で転記をします。
下図はパラメータシートのイメージです。
Function fncCopyAndPaste( _
ByVal wksInp As Worksheet, _
ByVal strInpColMin As String, _
ByVal lngInpRowMin As Long, _
ByVal strInpColMax As String, _
ByVal lngInpRowMax As Long, _
ByVal wksOut As Worksheet, _
ByVal strOutCol As String, _
ByVal lngOutRow As Long, _
ByVal intPasteOption As Integer, _
ByRef strMsgPrompt As String _
)
'変数定義
Dim intRet As Integer
Dim rngInp As Range
Dim rngOut As Range
'初期設定
On Error GoTo Err01
'最下行取得
If 0 = lngInpRowMax Then
lngInpRowMax = wksInp.Cells(Rows.Count, 1).End(xlUp).Row
End If
'入力範囲取得
Set rngInp = wksInp.Range(strInpColMin & lngInpRowMin, strInpColMax & lngInpRowMax)
'出力範囲取得
Set rngOut = wksOut.Range(strOutCol & lngOutRow)
'転記
rngInp.Copy
rngOut.PasteSpecial Paste:=intPasteOption
Application.CutCopyMode = False
'終了
fncCopyAndPaste = 0
Exit Function
Err01:
intRet = Err.Number
fncCopyAndPaste = intRet
strMsgPrompt = "エラー番号：" & intRet & vbCrLf & _
"エラー内容：" & Err.Description
End Function
呼び出し元
前回作成した配列作成関数の戻り値と組み合わせ、ループ処理にしました。
'配列「入力ファイル一覧」ループ
For intInpCnt = 0 To UBound(arrInp, 1)
'入力ファイル設定
strInpID = arrInp(intInpCnt, 0)
strInpWkb = arrInp(intInpCnt, 3)
strInpWks = arrInp(intInpCnt, 4)
'入力ファイルを開く
Set wkbInp = Workbooks.Open(strInpWkb)
Set wksInp = wkbInp.Worksheets(strInpWks)
'出力ファイルを開く
Set wkbOut = Workbooks.Open(strOutWkb)
Set wksOut = wkbOut.Worksheets(strOutWks)
'配列「転記」ループ
For intCopyCnt = 0 To UBound(GvarListCopy, 1)
If strInpID = GvarListCopy(intCopyCnt, 0) Then
'転記情報取得
strInpCopyColMin = GvarListCopy(intCopyCnt, 5)
strInpCopyColMax = GvarListCopy(intCopyCnt, 6)
lngInpCopyRowMin = GvarListCopy(intCopyCnt, 7)
lngInpCopyRowMax = GvarListCopy(intCopyCnt, 8)
strOutCopyColMin = GvarListCopy(intCopyCnt, 14)
lngOutCopyRowMin = GvarListCopy(intCopyCnt, 15)
intPasteOption = GvarListCopy(intCopyCnt, 16)
'転記
RintRet = fncCopyAndPaste(wksInp, _
strInpCopyColMin, _
lngInpCopyRowMin, _
strInpCopyColMax, _
lngInpCopyRowMax, _
wksOut, _
strOutCopyColMin, _
lngOutCopyRowMin, _
intPasteOption, _
RstrMsgPrompt)
'処理結果確認
If 0 <> RintRet Then
Exit Function
End If
End If
Next intCopyCnt
'入力ファイルを保存せずに閉じる
Application.DisplayAlerts = False
wkbInp.Close savechanges:=False
Application.DisplayAlerts = True
'出力ファイルを保存して閉じる
wksOut.Cells(1, 1).Select
wkbOut.Close savechanges:=True
Next intInpCnt
エンジニアファーストの会社 株式会社CRE-CO S.K