【VBA】別ブックへの転記方法

質問

左図の様に、2シート目から最終シート目迄、各シートに行数の異なるデータが有ります。
各シートとも、列数や書式は同一です。シート数は都度変動します。

上記を、
既に開いている別ブックへ転記したいです。(右図)
右図のブックでは、予め転記用のシートが多数用意されており、シート作成の処理は不要となります。

どうぞ宜しくお願いします。

回答No.3

SI299792 · ベストアンサー

済みません。これは
　　Application.CutCopyMode = False
のミスです。
間違えて作成途中のものを載せてしまいました。
これは、コピーした時の緑の点線を消すためのものです。

ちなみに、全て貼り付けなら、
Option Explicit
'
Sub Macro2()
　　Dim Sheet As Integer
　　Dim SheetName As String
'
　　For Sheet = 2 To ThisWorkbook.Sheets.Count
　　　　SheetName = ThisWorkbook.Sheets(Sheet).Name
　　　　ThisWorkbook.Sheets(Sheet).UsedRange.Copy _
　　　　　　Workbooks("転記先ブック.xlsx").Sheets(SheetName & "転記先").[A1]
　　Next Sheet
End Sub

でもいいです。この書き方なら、
　　Application.CutCopyMode = False
はいりません。

お礼

SI299792 様

サンプルでは、転記先ブックのシート名を指定してしまったので、
実作業版と形式が少し異なり、苦戦していました。
シート名置き換えコードにて転記元と転記先のシート名を一致させてから
お教え頂いたコードを実行したところ、上手くいきました。
(もっと手っ取り早い方法が有ると思いますが)

コードは出来る限り読み解き、勉強させて頂きます。
有難うございました。

回答No.4

imogasi

よくあるVBA質問のパターンだ。
WEBでも調べれば、近い処理のコードが見つかるだろう。
してほしいことだけ書いたり、写真だけを張り付けるのでなく、丸投げしてないで、下記のようなことを勉強のこと。
ーー
必要な要素技術（VBAコードの１塊）を、自力で割り出せる（１行の文章化できる）ようになって、どういうエクセル術語でWEB照会したらよいか、考える訓練をすること。
（１）各シートすべてを処理するならFor Each がよい。
Sub test01()
For Each sh In Worksheets
If sh.Name <> "Sheet1" Then
MsgBox sh.Name
'処理
End If
Next
End Sub
ーー
(2)
If sh.Name <> "Sheet1" Then　は
Sheet1 のシートだけ処理しない、を記述した部分
ーー
(3)
あるシートの、Ａ列のデータ最終行を検出する。
'処理
lr = sh.Range("A100000").End(xlUp).Row
MsgBox lr
ーー
（４）
又はCurrentreginを使って範囲を掴む、手もある。
---
途中版
仮にSheet1に集約する。
Sub test01()
For Each sh In Worksheets
If sh.Name <> "Sheet1" Then
MsgBox sh.Name
'処理
'--現瞬間の集約シートのA列最終行
lr = Worksheets("Sheet1").Range("A100000").End(xlUp).Row
MsgBox "Sheet1A列最終行　" & lr
'---
sh.Range("A1").CurrentRegion.Copy Sheets("Sheet1").Range("A" & lr + 1)
End If
Next
End Sub
こんな簡単なコードで、このブックの、Sheet1に集約できる。
さらに
＞開いている別ブックへ転記したいです
Ｓｈｅｅｔ１のデータをそのブックのＳｈｅｅｔ１などへコピー貼り付けはどうするか、勉強するのだ。
場合によったら、初学者のうちは、手作業でこのステップは済ますなど割り切り
、徐々に勉強してレパートリーを増やす手もある。
他人にやらせて、コード丸写しはよくない。

回答No.2

kkkkkm

マスタが左端にあり転記先ブックのシート名が質問の画像のように010転送先のようになっているとした場合です。
E列が合計なのでE列の最終行が全体の最終行として考えています。

Sub Test()
Dim i As Long
Dim pBook As Workbook

Set pBook = Workbooks("転記先ブック.xlsm")

For i = 2 To Sheets.Count
With ThisWorkbook.Sheets(i)
.Range(.Cells(1, "A"), .Cells(Rows.Count, "E").End(xlUp)).Copy _
pBook.Sheets(.Name & "転記先").Range("A1")
End With
Next
Application.CutCopyMode = False
Set pBook = Nothing
End Sub

回答No.1

SI299792

開いているシートだけコピーするのか、全てコピーするのか、
全貼り付けか値貼り付けか、
４通り考えれるのですが、全て書くわけにはいきません。
全シート、値貼り付けを載せます。

Option Explicit
'
Sub Macro1()
　　Dim Sheet As Integer
　　Dim SheetName As String
'
　　Windows("転記先ブック.xlsx").Activate
'
　　For Sheet = 2 To Sheets.Count
　　　　SheetName = ThisWorkbook.Sheets(Sheet).Name
　　　　ThisWorkbook.Sheets(Sheet).UsedRange.Copy
　　　　Sheets(SheetName & "転記先").[A1].PasteSpecial xlPasteValues
　　Next Sheet
　　ActiveSheet.CutCopyMode = False
End Sub

お礼

SI299792様

上記失礼しました。試行の結果概ねうまく行きました。
補足は撤回します。

不具合ですが、
・転記元最終シートが取得されず、転記先ブックにコピーされません。
・「ActiveSheet.CutCopyMode = False」で実行時エラーが出ます。

解決策のご回答が可能でしたら、お願いします。

補足

SI299792様

ご回答有難うございました。
説明不足ですみません。

転記先ブックへは、
転記元ブックのデータ範囲だけを、書式・数式を含めて
転記先ブックに転記するコードが知りたいです。

お手数でなければご教示願います。