再質問 EXCEL データをコピーして別シートの最初の空白行に貼り付け

質問

再質問　EXCEL　データをコピーして別シートの最初の空白行に貼り付けたい

QNo.6023986でEXCEL　データをコピーして別シートの最初の空白行に貼り付けたいと書き込んだものです。

質問内容は以下の通りです。

Sheet１はA列からR列までを使ったシートで、1行目は各項目があり、2行目からは当月のデータが入力されています。
Sheet２はSheet１の1行目と同じようにA列からR列までが項目になっていて、期中のデータを付け足していきたいと思っています。
マクロの記録でやってみたのですが、前月の最後の行（貼り付ける最初の空白行)の認識の仕方が分からず、Sheet２への貼付がうまくいきません。
どのような方法でやったらいいのか教えて下さい。
-----------------------------------------------------------------------------------

回答で以下のマクロを教えていただき、テストではうまくいったのですが、
ひとつのブック内でsheet１をsheet2に、sheet3をsheet4に、sheet5をsheet6にと行いたいので、
以下のコードのシート名をそれぞれ書き換えてやってみました。

ところが、１を２にはできたのですが、３を４でやってみたところ、
なんどやっても『400』というエラーが出てしまいます。

シート名の他にも書き換えが必要なのか教えてください。
よろしくお願いします。

Sub Macro1()

GYOU1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
GYOU2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1

Sheets("Sheet1").Select
Range(Cells(2, 1), Cells(GYOU1, 18)).Copy
Sheets("Sheet2").Select
Range("A" & GYOU2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

回答No.25

mar00 · ベストアンサー

お詫び
こちらから回答させてもらったマクロは
どれも動作確認して問題なく動作したものです。
しかしorange1010さんの方では正しく動作しないという事で
原因はなにかと色々考えましたが、こちらで同じ問題がおこらないので
どうしてなのかわかりません(私の力量不足です。)
もう一度、改めて質問して他の人の知恵を借りた方が解決するのも
早いと思います。
解決出来ないままなのは本当に残念ですが、orange1010さんも
早く解決させたいと思いますので、回答するのを終わりにさせてもらいます。
本当に申し訳ないです。すいません。

お礼

今までこんなにお付き合いいただいただけでも助かりました。
ありがとうございました。

回答No.24

mar00

Sub Macro71()
Dim GYOU As Integer

Sheets("1-4").Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Sheets("1-1").Select
For INP = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Sheets("1-1").Select
GYOU = GYOU + 1
For INP2 = 1 To 18
Sheets("1-1").Select
DATA = Cells(INP, INP2).Value
Sheets("1-4").Select
Cells(GYOU, INP2) = DATA
Next INP2
Next INP
Application.ScreenUpdating = False
Sheets("1-4").Select
Range("A1").Select
End Sub
を実行してみて下さい。
1-4にコピーされるまで砂時計になって
少々時間がかかりますが。

お礼

Sub Macro71()
Dim GYOU As Integer

Sheets("1-4").Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Sheets("1-1").Select
ここから　For INP = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Sheets("1-1").Select
GYOU = GYOU + 1
For INP2 = 1 To 18
Sheets("1-1").Select
DATA = Cells(INP, INP2).Value
Sheets("1-4").Select
Cells(GYOU, INP2) = DATA
Next INP2
Next INP
ここへ　Application.ScreenUpdating = False
Sheets("1-4").Select
Range("A1").Select
End Sub

"ここから""ここへ"と書いたところ
ここからここへ飛びます。
また砂時計にもならず貼り付けされませんでした。

回答No.23

mar00

15から19を繰り返しているという事は
正しい動作をしているという事です。
1-4にデータがはいると思います。
ステップインではなくて普通にマクロを実行してみて下さい。

お礼

1 Sub Macro1()
2 Dim GYOU As Integer
3 Dim INP As Long

4 Sheets("1-4").Select
5 GYOU = Cells(Rows.Count, 1).End(xlUp).Row
6 'Application.ScreenUpdating = False
7 Sheets("1-1").Select
8 For INP = 2 To 1000000
9 Sheets("1-1").Select
10 If IsEmpty(Cells(INP, 1)) Then
11 Exit For
12 Else
13 GYOU = GYOU + 1
14 For INP2 = 1 To 18
15 Sheets("1-1").Select
16 DATA = Cells(INP, INP2)
17 Sheets("1-4").Select
18 Cells(GYOU, INP2) = DATA
19 Next INP2
20 End If
21 Next INP
22 'Application.ScreenUpdating = False
23 Sheets("1-4").Select
24 Range("A1").Select
25 End Sub

11から22に飛んで貼り付けされずに終わってしまいました・・・・

回答No.22

mar00

もういぢそのままマクロを実行してみて下さい。

シート1-1にシートの保護など通常の書式設定以外に
何か設定してますか?。

お礼

設定してないです。
’をはずして実行してみたところ、19まで行って、
15に戻るということを繰り返しているようです。

回答No.21

mar00

11から22に飛ぶということなので
6 Application.ScreenUpdating = Falsesと
22 Application.ScreenUpdating = Falseの
頭に　'　を追加(緑色に変わる)
シート1-1のセルA2に入力されたデータがあるかを確認して下さい。

シート1-1のセルA2に入力されたデータがある場合
シート1-1を開く
ステップインを開始
マクロではなくてExcelの動きを確認しながら
5が黄色くなった時、シート1-4が開いているか
6が黄色くなった時、GYOUは2になっているか
8が黄色くなった時、シート1-1が開いているか
以上を確認して下さい。

シート1-1のセルA2に入力されたデータがない場合
8の1000000を
Cells(Rows.Count, 1).End(xlUp).Rowになおす
10から12、20を削除
してから実行してみて下さい。

お礼

ご指導通り、以下のように変えました。
1 Sub Macro1()
2 Dim GYOU As Integer
3 Dim INP As Long

4 Sheets("1-4").Select
5 GYOU = Cells(Rows.Count, 1).End(xlUp).Row
6 'Application.ScreenUpdating = False
7 Sheets("1-1").Select
8 For INP = 2 To 1000000
9 Sheets("1-1").Select
10 If IsEmpty(Cells(INP, 1)) Then
11 Exit For
12 Else
13 GYOU = GYOU + 1
14 For INP2 = 1 To 18
15 Sheets("1-1").Select
16 DATA = Cells(INP, INP2)
17 Sheets("1-4").Select
18 Cells(GYOU, INP2) = DATA
19 Next INP2
20 End If
21 Next INP
22 'Application.ScreenUpdating = False
23 Sheets("1-4").Select
24 Range("A1").Select
25 End Sub

>シート1-1のセルA2に入力されたデータがあるかを確認して下さい
あります。1-1のA2にはいつもデータが入った状態です。

>5が黄色くなった時、シート1-4が開いているか
開いています。

>6が黄色くなった時、GYOUは2になっているか
　5から７に飛ぶので確認できませんでした。

>8が黄色くなった時、シート1-1が開いているか
　開いています。

回答No.20

mar00

すいません。
回答を送ったと思っていたのですが
送信されていませんでした。
行数の増減は問題ないです。
Sub Macro1()
Dim GYOU As Integer
Dim INP As Long

Sheets("1-4").Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Sheets("1-1").Select
For INP = 2 To 1000000
Sheets("1-1").Select
If IsEmpty(Cells(INP, 1)) Then
Exit For
Else
GYOU = GYOU + 1
For INP2 = 1 To 18
Sheets("1-1").Select
DATA = Cells(INP, INP2)
Sheets("1-4").Select
Cells(GYOU, INP2) = DATA
Next INP2
End If
Next INP
Application.ScreenUpdating = False
Sheets("1-4").Select
Range("A1").Select
End Sub
一度試してみてください。
今回もダメでしたらNext INPのところにブレークポイントを
設定して、中断したらINPの数値を確認して下さい。
最初は2です。
確認したら継続ボタンを押してまたINPを確認
この作業を数回行ってください。
下から3行目に飛んで終了してしまったら最後に確認した
INPの数値を教えて下さい。

お礼

1　　Sub Macro1()
2　　Dim GYOU As Integer
3 Dim INP As Long

4 Sheets("1-4").Select
5 GYOU = Cells(Rows.Count, 1).End(xlUp).Row
6 Application.ScreenUpdating = False
7 Sheets("1-1").Select
8 For INP = 2 To 1000000
9 Sheets("1-1").Select
10 If IsEmpty(Cells(INP, 1)) Then
11 Exit For
12 Else
13 GYOU = GYOU + 1
14 For INP2 = 1 To 18
15 Sheets("1-1").Select
16 DATA = Cells(INP, INP2)
17 Sheets("1-4").Select
18 Cells(GYOU, INP2) = DATA
19 Next INP2
20 End If
21 Next INP
22 Application.ScreenUpdating = False
23 Sheets("1-4").Select
24 Range("A1").Select
25 End Sub

ありがとうございます。お返事が遅くなって申し訳ありません。
まず、最初に教えてください。
左側に番号を振りましたが、
(1)21にブレークポイントでいいですか？
(2)ステップインを開始すると1から4に飛びますがいいですか？
(3)11から22に飛びますがいいですか？
(4)INPの値というのは8以降の10/16/21のことでしょうか？

よろしくお願いします。

回答No.19

mar00

念のためですが、一番最初のマクロです。
Sheet1、Sheet2のやつです。
もう一度動かしてみてください。
Sub Macro1()
GYOU1 = Sheets("1-1").Cells(Rows.Count, 1).End(xlUp).Row
GYOU2 = Sheets("1-4").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("1-1").Select
Range(Cells(2, 1), Cells(GYOU1, 18)).Copy
Sheets("1-4").Select
Range("A" & GYOU2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
これが正常に動かないということはSheet1、Sheet2の時と
1-1、1-4のどこかが違うのではないかと思います。
Sheet1と1-1だとは思うのですが。

それとANo.18のマクロですが
EXIT FORから
下から３行目に飛ぶということですが
1-1のA列に空白セルが出てきたら飛ぶようになっているのですが
A列は１行目が項目で２行目から最後の行までデータが入力されているのでは
ないのでしょうか?

お礼

本当に申し訳ありません。
混乱してしまっています。
最初から確認してみたところ、最初のファイルと今のファイルでは行数が違う事に気づきました。
本当にすみません・・・
マクロの記録を取ってしまい行数が18ではなく15になっていたのです。
15に変えてみたのですが、出来なかったということは他にもいじる所があるのでしょうか。

以下、現在使用しているファイルです。

1-1（月１でやる作業です)

A1～O1まで項目
A2～O2よりデータが入っています。
Q2～R28まではA2～O2のデータをカウントする為の数式等が入っています。

1-4（1-1のデータを一年分とり、ピボットするために継ぎ足していくシートです)

A1～O1まで項目（1-1)と同じ項目が入っています。

これと同じ作業を他に２種やります。（項目の数は違います)

私が知識がなさ過ぎる為に、こんなことになってしまって本当に申し訳ありませんでした。
もう一度お力添えいただけないでしょうか？

回答No.18

mar00

Sub Macro5()
Dim GYOU As Integer
Dim INP As Long

Sheets("1-4").Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row
'Application.ScreenUpdating = False
Sheets("1-1").Select
For INP = 2 To 1000000
Sheets("1-1").Select
If IsEmpty(Cells(INP, 1)) Then
Exit For
Else
GYOU = GYOU + 1
Sheets("1-1").Select
Range(Cells(INP, 1), Cells(INP, 18)).Copy
Sheets("1-4").Select
Range("A" & GYOU).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next INP
'Application.ScreenUpdating = False
Sheets("1-4").Select
Range("A1").Select
End Sub
シート名の1-1、1-4は半角でテンキーから入力しています。

お礼

ペーストされませんでした…
Exit Forから下から3行目のSheets("1-4").Selectに飛ぶんですが、
それは問題ではないですか？

回答No.17

mar00

orange1010さんの返事を見ましたが
マクロは正しく動作しているようです。
ただペーストされずに終了した所を除けばですが。
ActiveSheet.Pastek部分を
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
に変えてみてください。
だめだった場合、
こっちも試して見て下さい。
Sub Macro5()
Dim WS1 As String
Dim WS2 As String
Dim GYOU As Long

WS1 = InputBox("元データを入力して下さい。")
WS2 = InputBox("コピー先を入力して下さい。")

Sheets(WS2).Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Sheets(WS1).Select
For INP1 = 2 To 1000000
Sheets(WS1).Select
If IsEmpty(Cells(INP1, 1)) Then
Exit For
Else
GYOU = GYOU + 1
For INP2 = 1 To 18
Sheets(WS2).Cells(GYOU, INP2) = Sheets(WS1).Cells(INP1, INP2)
Next INP2
End If
Next INP1
Application.ScreenUpdating = False
Sheets(WS2).Select
Range("A1").Select
End Sub

お礼

どちらも試してみましたが、
ペーストされませんでした…。

回答No.16

mar00

Sub Macro1()
Dim WS1 As String
Dim WS2 As String
Dim GYOU1 As Long
Dim GYOU2 As Long

WS1 = InputBox("元データを入力して下さい。")
GYOU1 = Sheets(WS1).Cells(Rows.Count, 1).End(xlUp).Row
WS2 = InputBox("コピー先を入力して下さい。") (1)

Sheets(WS1).Select (2)
Range(Cells(2, 1), Cells(GYOU1, 18)).Copy (3)
Sheets(WS2).Select (4)
GYOU2 = Sheets(WS2).Cells(Rows.Count, 1).End(xlUp).Row + 1 (5)
Cells(GYOU2, 1).Select (6)
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
End Sub
(1)の行が黄色くなった時、GYOU1を(1-1のデータの最終行になるはず)
(3)の行が黄色くなった時、1-1が選択されているかを
(4)の行が黄色くなった時、1-1のデータ範囲が選択されているかを
(5)の行が黄色くなった時、1-4が選択されているかを
(6)の行が黄色くなった時、GYOU2を
のように確認したい対象がある次の行が黄色くなった時に
どういう値になっているかを確認してほしいのです。
最初の方は黄色くなっている時に確認してもEmpty値になります。
通り過ぎて初めて変数が設定されるためです。

お礼

そういうことだったんですか…申し訳ありませんでした。

(1)　　Sub Macro1()
(2)　　Dim WS1 As String
(3)　　Dim WS2 As String
(4)　　Dim GYOU1 As Long
(5)　　Dim GYOU2 As Long

(6)　　WS1 = InputBox("元データを入力して下さい。")
(7)　　GYOU1 = Sheets(WS1).Cells(Rows.Count, 1).End(xlUp).Row
(8)　　WS2 = InputBox("コピー先を入力して下さい。") (1)

(9)　　Sheets(WS1).Select (2)
(10)　　Range(Cells(2, 1), Cells(GYOU1, 18)).Copy (3)
(11)　　Sheets(WS2).Select (4)
(12)　　GYOU2 = Sheets(WS2).Cells(Rows.Count, 1).End(xlUp).Row + 1 (5)
(13)　　Cells(GYOU2, 1).Select (6)
(14)　　ActiveSheet.Paste
(15)　　Application.CutCopyMode = False
(16)　　Range("A1").Select
(17)　　End Sub

以下、やってみたご報告です。
(1)の行が黄色くなった時、GYOU1を(1-1のデータの最終行になるはず)
　>左の数字(7)のGYOU1の所　→　GYOU1=301となっていますので合ってます。

(3)の行が黄色くなった時、1-1が選択されているかを
　>左の数字(9)の（WS1）の所　→　WS=”1-1”となっています。

(4)の行が黄色くなった時、1-1のデータ範囲が選択されているかを
　>左の数字(10)の（GYOU1,の所　→　GYOU=301

(5)の行が黄色くなった時、1-4が選択されているかを
　>左の数字(11)の（WS2）の所　→　WS=”1-4”

(6)の行が黄色くなった時、GYOU2を
　>(12)のGYOU2の所　→　GYOU2＝2

このようになっています。
ただペーストされずに終了してしまいました。

よろしくお願いします。

回答No.15

mar00

Sub Macro1()
Dim WS1 As String
Dim WS2 As String
Dim GYOU1 As Long
Dim GYOU2 As Long

WS1 = InputBox("元データを入力して下さい。")
GYOU1 = Sheets(WS1).Cells(Rows.Count, 1).End(xlUp).Row
WS2 = InputBox("コピー先を入力して下さい。") (1)

Sheets(WS1).Select (2)
Range(Cells(2, 1), Cells(GYOU1, 18)).Copy (3)
Sheets(WS2).Select (4)
GYOU2 = Sheets(WS2).Cells(Rows.Count, 1).End(xlUp).Row + 1 (5)
Cells(GYOU2, 1).Select (6)
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
End Sub
(1)の行が黄色くなった時、GYOU1を(1-1のデータの最終行になるはず)
(3)の行が黄色くなった時、1-1が選択されているかを
(4)の行が黄色くなった時、1-1のデータ範囲が選択されているかを
(5)の行が黄色くなった時、1-4が選択されているかを
(6)の行が黄色くなった時、GYOU2を
のように確認したい対象がある次の行が黄色くなった時に
どういう値になっているかを確認してほしいのです。
最初の方は黄色くなっている時に確認してもEmpty値になります。
通り過ぎて初めて変数が設定されるためです。