VBAで、行のcopy,Paste

環境：WindowsXPSP3 Office2010です。

ヤリタイ事その1
(1)BookAのSeet4以降にSheet(1行目のセルには項目が入っています、列数はみな同じです。行数は違います)を追加していきたい。
(2)使っていないSheet1,2,3はスキップする。一行目には、何年何組、男女の区別、生徒氏名、生徒証番号、1学期の中間試験の国語の成績、1学期の期末試験の国語の成績、担当教員名、2学期の中間試験の算数の成績、担当教員名、・・・・・・
(3)追加したSheetnの最後のSheetnにもう一つSheetn+1を追加したい。
(4)Seet4からSheetnまでの各SheetのセルをSheetn+1に「下向けに」貼り付けていきたい。
(5)何年何組が40あったら、まづ、40行、次に何年何組が20あったら、次の20行、・・・・
前回ご指導頂いた方法で試しました。ちょっと変更しましたが、その時は、ほぼ旨くいきました。
Worksheets.Add Before:=Worksheets(1)
Dim sheetsuu As Integer 'sheetsuuはシートの数です。
Dim kk As Integer
Dim m As Integer
sheetsuu = ActiveWorkbook.Worksheets.count
For kk = 4 To sheetsuu - 1 Step 1
Worksheets(kk - 3).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
Next kk
しかし、Sheetn+1にSheet4の1行目をPasteしようしましが、旨くいきません。
要するに項目がcopy,Pasteとしようとしましたが、旨くいきません。
手打ちでは、出来ます。Sheet4の一行目Ctrl+C シートの最後まで行き、Ctrl+Vで出来ます。
しかし、マクロを使うと出来ません。どなたか、ご指導して頂けませんでしょうか？
何卒宜しくお願い申し上げます。

ヤリタイ事その2
(1)上記【ヤリタイ事その1】が、出来たら、Sheetn+1を別のBook1.xlsxに
copy,Pasteとしようとしましたが、旨くいきません。
これも色々検索しました。
試した数、デバック文を入れた物沢山ありますが、旨くいきそうな例を下記にしまします。
下記も旨くいかない例です。
Dim nWbk As Workbook
Set nWbk = Workbooks.Add
ThisWorkbook.Worksheets("Sheet &kk").Copy Before:=Worksheets("Sheet1")
どなたか、ご指導して頂けませんでしょうか？
何卒宜しくお願い申し上げます。

No.2 ベストアンサー 回答者： ap_2 回答日時： 2012/07/12 15:43

なんだかイマイチわからないけど（・＿・；

その２は、ANo.1の指摘どおりですね。名前は不定なのでsheets(1)で。
その１は・・・

◆ こういうことかな？
'--> ループの3行を差し替え
Worksheets(2).Rows(1).Copy Rows(1) 'タイトル行コピー
For kk = 2 To sheetsuu - 3 Step 1
　Worksheets(kk).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
Next kk
'<--
※Rowsは行。わかりにくければコッチで↓
Worksheets(2).Range("A1:Z1").Copy Range("A1:Z1")

◆以下、説明
回答に頼ると、理解がおいつかず混乱しがち。
ちゃんと処理を理解してね！！

◇ コピー対象がおかしい？
> For kk = 4 To sheetsuu - 1 Step 1
>　Worksheets(kk - 3)...
-3 してるので結局、sheets(1 to sheetsuu - 4)になってます。シートindexは左から1,2,3・・・。直前で左端(1)に追加しているので、コピー対象は 2 ～ sheetsuu-3 では？
たぶんsheets(1)にはAutoFilterがないので、オブジェクトがない！ってエラーになるかと。

◇ タイトル行をコピーする処理
が無いのは分かってる・・・？念のため説明
　.AutoFilter：オートフィルターの
　.Range　　：セル範囲を
　.Offset(1)：下方に１ずらした範囲
をコピーしてます。
タイトル行を含まないようズラしているので、コレはOK。あとは、ループ前(か後)にタイトル行のみをコピーするだけ。

◇ デバッグ
コピーなんてセルを正しく指定するだけなので、セル選択でもすれば１発で確認できます。
for kk = 1 to sheets.count
　sheets(kk).Select
　sheets(kk).AutoFilter.Range.Select
　Stop　'一時停止(F5/F8で継続)
　Selection.Offset(1).Select
　Stop　'一時停止(F5/F8で継続)
next
こういうの大事。１つずつ確認。理解も深まります。

また、ブレイクポイント、ステップ実行、ローカルウィンドウなど、便利なデバッグ機能も多いです。ぜひ使えるようになってください。

この回答へのお礼

皆さんどうも有難う御座いました。問題の説明不足で、混乱を招いてしまったみたいですけど、皆さんのご回答を参考にさせて頂き無事解決しました。本当に有難う御座いました。これからも何卒宜しくお願い申し上げます。

お礼日時：2012/07/13 07:09

No.4 回答者： piyo_dansyaku 回答日時： 2012/07/12 23:51

No1です

No2様、フォローありがとうございます

コピー＆ペーストの方法で

.Copy コピー先

という書き方があるんですね。お騒がせしてすいませんでした。

No.3 回答者： ap_2 回答日時： 2012/07/12 15:51

>>ANo.2

補足。Worksheets(2)はSheet4じゃなくてSheetNだと思うけど。同じだよね・・

No.1 回答者： piyo_dansyaku 回答日時： 2012/07/11 17:06

不具合が発生する箇所

＞For kk = 4 To sheetsuu - 1 Step 1
４から始まるのに、終わりが４未満になるケースが発生するのは不正

＞Worksheets(kk - 3).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
コピーしたあとの貼り付け（PasteSpecial等）が無い






質問者様のやりたい事と少しづれているかもしれませんが、作ってみました。


Sub SheetAdd()

Dim sheetsuu As Integer 'sheetsuuはシートの数です。
Dim kk As Integer
Dim m As Integer
Dim strtNum As Integer 'シートN+1の貼りつけ開始行
Dim endNum As Integer 'シートN+1の貼りつけ終了行
'シート数を取得
sheetsuu = ActiveWorkbook.Worksheets.Count

'シート数が４以上ある事下記処理を行う
'シート数：(スキップ用のシート数+取得元Ｎシート数）
If sheetsuu + 1 > 4 Then
'シート数Ｎの数分、値を取得
For kk = 4 To sheetsuu - 1 Step 1

ActiveWorkbook.Worksheets(kk).Activate

MaxRow = ActiveWorkbook.Worksheets(kk).Cells(Rows.Count, 1).End(xlUp).Row

'１行目の項目行以降に値が設定されているか判定
If MaxRow > 1 Then
Worksheets(kk).Range("2:" & MaxRow).Copy

'貼りつけ開始行・終了行を設定
strtNum = endNum + 1
endNum = endNum + MaxRow - 1

'シートＮ＋１に値を設定
'１行目に値を設定する場合
If strtNum = 1 Then
Worksheets(sheetsuu).Range("1:" & endNum).PasteSpecial
'２行目以降に値を設定する場合
Else
Worksheets(sheetsuu).Range(strtNum & ":" & endNum).PasteSpecial
End If
End If

Next kk

End If
End Sub



補足：

本マクロは、シートＮ及びシートＮ＋１がある場合に動きます。

理由は、毎回実行するとシートが増え続けてしまうからです。
最終のシート名が決まっていれば、if文を追加して、Addすれば問題ないかと思います。



＞Worksheets(kk - 3).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
エクセルで複数シートの同時コピーは可能ですか？
そのあたりが、少しわからなかったので、１シートごとに値を貼りつける処理で作ってみました。





ヤリタイ事その2

＞ThisWorkbook.Worksheets("Sheet &kk").Copy Before:=Worksheets("Sheet1")

変数は""で囲んではいけません。
シート名が、Sheet & kkとなります。
書くなら、("Sheet" & kk)

Worksheetsの引数はSheet1より、1のほうがよいのでは？
場合によりけりですが、Sheet1が無い場合、エラーとなります。
もちろん、１番目にSheet2が来てる場合は別ですが・・・

この回答へのお礼

ご回答頂けるとは、思いもしませんでした。本当に有難う御座います。明日ためして見ます。

お礼日時：2012/07/11 20:00