VBAでの他のシートにコピー

質問

今sheet1へ、sheet2とsheet3のデータをコピーしようとしています。
sheet1は見出しが2行目にあり、3行目からsheet2をコピーしようとしています。
そのつぎに、sheet3はsheet1にsheet2のコピーした次の行からコピーします。

sheet2　
　　Ａ　　Ｂ　　Ｃ
3　鈴木　りんご　5
4　山田　バナナ　1

sheet3
　　Ａ　　Ｂ　　Ｃ　
3　大羽　メロン　2
4　鷲尾　スイカ　1

　↓２行目まで見出しがあるsheet1に
sheet1
　　Ａ　　Ｂ　　Ｃ
3　鈴木　りんご　5
4　山田　バナナ　1　
5　大羽　メロン　2
6　鷲尾　スイカ　1

このとき、シート２とシート３は数は決まっていません。
そして、数が０のときもあるので「sheet2とsheet3にデータがないときはコピーしない」
をというふうにしたいのですが、どのようにすればよろしいですか？
VBAで行いたいです。よろしくお願いします。

回答No.5

hige_082

質問の処理をするだけなら、数行で出来ますよ
ちょっと長くなるけどね

Sub test()
Dim sh As Worksheet
For Each sh In Worksheets(Array("sheet2", "sheet3"))
If sh.Range("a65536").End(xlUp).Row > 2 Then sh.Range("a3", sh.Range("c65536").End(xlUp)).Copy Worksheets("sheet1").Range("a65536").End(xlUp).Offset(1)
Next
End Sub

難しいことはしていないので、分らない所はヘルプを参照してください

回答No.4

imogasi

回答者は誰も何も言わないが、課題丸投げで、コードを回答者に書いてもらうようなのは、規約違反のはず。
コードをコピー貼り付けすれば質問者は簡単だが、そんな下請けになりたくない。
少なくても具体例でマクロの記録を取り、実際の場合はどこを変えるべき（相対化すべき）か勉強して、疑問点ぐらい絞ること。
（１）貼り付けたあとで、データ最終行を捉えるコードさえわかれば仕舞いのはなし。
（２）コピー元にデータが無ければ、コピー先で最下行が変化しないだけの話。ただし見出しが邪魔をする場合が有るので手わ打った。
（３）コピー先は左上隅セルをDestinationで指定すれは済む話。
（４）シートがSheet2,Sheet3（実際はもっと多いのを質問で簡略化したのかな）有るので、シートをコード上で区別するコードを勉強すること。
ーーー
Sheet1の第１行目には見出しを入れて下記を実行
第１行があれば見出しだけと看做す。
Sub test01()
Dim sh1: Dim shn
Set sh1 = Worksheets("Sheet1")
s = Array("Sheet2", "Sheet3")
For i = 0 To UBound(s)
Set shn = Worksheets(s(i))
'MsgBox shn.Name
d1 = sh1.Range("a65536").End(xlUp).Row
d2 = shn.Range("a65536").End(xlUp).Row
If d2 <> 1 Then
shn.Range("A2:C" & d2).Copy Destination:=sh1.Range("A" & d1 + 1)
Set shn = Nothing
End If
Next i
End Sub

回答No.3

kazuho_goo

こんなのでどうでしょう？

Private Const DATA_CELL_SCOL As String = "A3"
Private Const DATA_CELL_ECOL As String = "C3"

Public Sub copySheet()

Dim srcSheet As Worksheet
Dim dstSheet As Worksheet

'コピー先
Set dstSheet = Worksheets("Sheet1")

'コピー元
Set srcSheet = Worksheets("Sheet2")
Call copyData(srcSheet, dstSheet)

'コピー元
Set srcSheet = Worksheets("Sheet3")
Call copyData(srcSheet, dstSheet)

End Sub

Private Sub copyData(srcSheet As Worksheet, dstSheet As Worksheet)

Dim rowEnd As Range
Dim copyDstCell As String

'コピー先のセルを設定
dstSheet.Activate
Set rowEnd = dstSheet.Range(DATA_CELL_SCOL).End(xlDown)
If rowEnd.Value = "" Then
copyDstCell = DATA_CELL_SCOL
Else
copyDstCell = rowEnd.Offset(1).Address(False, False)
End If

'コピー元のデータ範囲を設定
srcSheet.Activate
Set rowEnd = srcSheet.Range(DATA_CELL_ECOL).End(xlDown)
If rowEnd.Value = "" Then
Exit Sub
End If

'コピー元→コピー先
srcSheet.Range(DATA_CELL_SCOL & ":" & rowEnd.Address(False, False)).Copy _
Destination:=dstSheet.Range(copyDstCell)

End Sub

回答No.2

chie65535

Private Sub CommandButton1_Click()
Dim RowSize As Integer
Dim LastRow As Integer
Worksheets("Sheet1").Select
ActiveSheet.Range("A3:C65535").Select
Selection.ClearContents
Worksheets("Sheet2").Select
RowSize = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
If RowSize >= 3 Then
ActiveSheet.Range(ActiveSheet.Cells(3, 1), ActiveSheet.Cells(RowSize, 3)).Select
Selection.Copy
Worksheets("Sheet1").Select
ActiveSheet.Range("A3").Select
ActiveSheet.Paste
LastRow = Selection.Rows.Count + 3
Else
LastRow = 3
End If
Worksheets("Sheet3").Select
RowSize = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
If RowSize >= 3 Then
ActiveSheet.Range(ActiveSheet.Cells(3, 1), ActiveSheet.Cells(RowSize, 3)).Select
Selection.Copy
Worksheets("Sheet1").Select
ActiveSheet.Cells(LastRow, 1).Select
ActiveSheet.Paste
End If
Worksheets("Sheet1").Select
End Sub

回答No.1

kybo

Sheet2、Sheet3のシートが2番目、3番目にあるとして。

Sub macro()
Dim I As Integer
For I = 2 To 3
With Worksheets(I)
If .Range("A" & .Rows.Count).End(xlUp).Row >= 3 Then
.Range("A3:C" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy _
　　Worksheets(1).Range("A" & Worksheets(1).Rows.Count).End(xlUp).Offset(1)
End If
End With
Next I
End Sub