VBAの質問です。

質問

VBAの質問です。
以下のプログラムで、４列おきにコピーしたい時はどうすればいいでしょうか？

１つのフォルダの中に集約第１期・集約第２期・集約第３期という名前の３つのファイルがあり、
その３つのファイル全てに「結果」というシートがあります。
この「結果」シートのC4:AU37の数値をコピーします。
コピーした数値を、集約第３期のファイルの中にある「集計用シート」のC2から貼り付けしていきたいのですが、
この時に、４列おきにはりつけたいと思っています。

集約第１期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-C２の列から４列おきに
集約第２期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-C３の列から４列おきに
集約第３期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-C４の列から４列おきに

といった具合です。
集約第３期ファイル-集計用シート-C５の列は空白し、C６からまた貼り付けます。
どこをどう直せば良いでしょうか？

Sub データ抽出()
Dim i As Long
Dim flg As Boolean
Dim myWb As Workbook
Dim myWbName As String

Application.ScreenUpdating = False

ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

ThisWorkbook.Worksheets("集計用シート").Range("C2:EG35").Clear

For i = 1 To 3
flg = False
myWbName = "集約第" & i & "期.xls"
If myWbName <> ThisWorkbook.Name Then
For Each myWb In Workbooks
If myWb.Name = myWbName Then flg = True
Next myWb
If flg = False Then
Workbooks.Open Filename:=myWbName
Else
Workbooks(myWbName).Activate
MsgBox myWbName & "を閉じてから再実行してください。"
Exit Sub
End If
End If
Worksheets("結果").Range("C4:AU37").Copy
ThisWorkbook.Worksheets("集計用シート").Range("C2").Offset(, 45 * (i - 1)).PasteSpecial Paste:=xlPasteValues
If myWbName <> ThisWorkbook.Name Then
Application.DisplayAlerts = False
Workbooks(myWbName).Close SaveChanges:=False
Application.DisplayAlerts = True
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

回答No.1

niguotd · ベストアンサー

>集約第１期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-C２の列から４列おきに
>集約第２期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-C３の列から４列おきに
>集約第３期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-C４の列から４列おきに

>といった具合です。
>集約第３期ファイル-集計用シート-C５の列は空白し、C６からまた貼り付けます。

を、

集約第１期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-C２の列から４列おきに
集約第２期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-D２の列から４列おきに
集約第３期ファイル-結果-C4の列→集約第３期ファイル-集計用シート-E２の列から４列おきに

集約第３期ファイル-集計用シート-F２の列は空白し、G２からまた貼り付けます。

と勝手に解釈しました。

Sub データ抽出()

Dim i As Long
Dim j As Long
Dim flg As Boolean
Dim myWb As Workbook
Dim myWbName As String
Dim intColumn As Integer
Dim intCopyStartColumn As Integer

Application.ScreenUpdating = False

ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

ThisWorkbook.Worksheets("集計用シート").Range("C2:EG35").Clear

For i = 1 To 3
flg = False
myWbName = "集約第" & i & "期.xls"
If myWbName <> ThisWorkbook.Name Then
For Each myWb In Workbooks
If myWb.Name = myWbName Then flg = True
Next myWb
If flg = False Then
Workbooks.Open Filename:=myWbName
Else
Workbooks(myWbName).Activate
MsgBox myWbName & "を閉じてから再実行してください。"
Exit Sub
End If
End If

If i = 1 Then
intCopyStartColumn = 3
ElseIf i = 2 Then
intCopyStartColumn = 4
Else
intCopyStartColumn = 5
End If

j = intCopyStartColumn

For intColumn = 3 To 47
Workbooks(myWbName).Worksheets("結果").Activate
Worksheets("結果").Range(Cells(4, intColumn), Cells(37, intColumn)).Copy
ThisWorkbook.Worksheets("集計用シート").Activate

ThisWorkbook.Worksheets("集計用シート").Cells(2, j).PasteSpecial Paste:=xlPasteValues
j = intCopyStartColumn + 4 * (intColumn - 2)
Next intColumn
If myWbName <> ThisWorkbook.Name Then
Application.DisplayAlerts = False
Workbooks(myWbName).Close SaveChanges:=False
Application.DisplayAlerts = True
End If

Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

お礼

早速のご回答ありがとうございました。

私の基本的なミス（列と行を混同していました）を正していただいた上に、
完璧なプログラムまで教えていただき、本当にありがとうございます。
先ほど、実際に使ってみましたが願っていた通りの結果になりました。

本当に、本当にありがとうございました。