コピーは次のようにそれでは、私がやりたいことはある

Question

最初の空のセルに、1つのワークシートに複数のワークシートの範囲：学生（私は学生の情報を30枚のワークシート、その後、一般的な情報を持つ2つのワークシートを含むブックを持って

番号、名前、成績、最終ワークグループ平均）、概要シート（「Overzicht-OSC」）が表示されます。

私がやりたいことは、学生番号（C列）と最終ワークグループ平均（L列）のみをコピーし、それらの値を概要シート（「Overzicht-OSC」）に貼り付けることです。すべてのワークグループには最大25名の生徒が含まれています。しばしばそれ以下であり、その数はグループごとに異なる。だから私が望むのは、 "Overzicht-OSC"に最初のグループの番号を（3枚目に）ペーストし、その情報の直下に2番目のグループの番号をペーストして、そこに空白のセルをスキップして、最終的な概観では学生番号と成績のみになります。

私はそのために次のコードを書いた：

Sub Overview() 

Dim I As Integer 
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer 
Dim currentRowValue As String 

For I = 3 To 32 

    Range("B8:B34,L8:L34").Copy 
    Sheets("Overzicht-OSC").Select 

     sourceCol = 1 
     rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row 

     For currentRow = 1 To rowCount 
      currentRowValue = Cells(currentRow, sourceCol).Value 
      If IsEmpty(currentRowValue) Then 
       Cells(currentRow, sourceCol).Select 
       Exit For 
      End If 
     Next 

    ActiveCell.PasteSpecial Paste:=xlPasteValues 

Next I 

End Sub 

をしかし、それは動作しません！私は様々なエラーメッセージを受け取り続けています。上記のバージョンでは、 'RangeクラスのPasteSpecialメソッドが失敗しました'というメッセージが表示されます。

「ActiveCell.PasteSpecial」を「Selection.PasteSpecial」に変更すると、「この選択は無効です。同じサイズと形状でなければ、コピーとペーストの領域が重ならないようにしてください。 '

私も、以前に別のコードを試してみました：

Sub Overzicht2() 

Dim I As Integer 

For I = 3 To 32 

    Range("C8:C34,L8:L34").Select 
    Selection.Copy 
    Sheets("Overzicht-OSC").Select 
    Application.Goto Cells(Rows.Count, "A").End(xlUp).Offset(1), Scroll:=True 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

Next I 

End Sub 

これはエラーメッセージを与えるものではありませんが、また動作しません。

これはどのように修正する必要がありますか？

Answer 1

コードの任意の場所でシートを参照していないため、どのセルがアクティブであるかがわからないため、ActiveCellは推奨されません。おそらく、これはうまくいくでしょうが、私はシートインデックスを簡単に変更できるように注意しています - シート名やコードネームを使う方が良いでしょう。

Sub Overzicht2() 

Dim I As Long 

For I = 3 To 32 
    Sheets(I).Range("C8:C34,L8:L34").Copy 
    Sheets("Overzicht-OSC").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues 
Next I 

End Sub