Excelのマクロに関する質問です。良い回答は、250ポイント差し上げます。

ブック内各シートのデータを連結したい。

※関数が入っているセルはを値のみ取得

【青森シート】
2-----青森------------------- ←セルを結合しています。
3  入金  出金   損害金
4  500   1000    300
5  800   900    100
6 650 950 200 ←平均関数
7 1300 1900 400 ←合計関数


□□□集計後のイメージ□□□□□□
【集計シート】
2-----青森------------------- ←セルを結合しています。
3  入金  出金   損害金
4  500   1000    300
5  800   900    100
6 650 950 200 ←平均関数
7 1300 1900 400 ←合計関数

------------------------------------------------------------------------------------
Private Sub CommandButton3_Click()
Dim dstRow As Long
dstRow = 3

Dim lastRow As Long
Dim i As Long

For i = 3 To Worksheets.Count
lastRow = Worksheets(i).Range("L" & Rows.Count).End(xlUp).Row
Worksheets(i).Rows(3 & ":" & lastRow).Copy _
Destination:=Worksheets(1).Rows(dstRow & ":" & (dstRow + lastRow - 2))
dstRow = dstRow + lastRow - 1
Next
End Sub
------------------------------------------------------------------------------------

回答の条件
  • 1人10回まで
  • 13歳以上
  • 登録:2011/02/28 08:50:48
  • 終了:2011/02/28 09:31:34

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912011/02/28 09:06:27

ポイント250pt

セルの結合が無ければ、一回の処理でできそうですが、

最初に全体コピーした後で、数式を値としてコピーしています。

Private Sub CommandButton3_Click()
    Dim dstRow As Long
    dstRow = 3
    
    Dim lastRow As Long
    Dim i As Long
    
    For i = 3 To Worksheets.Count
        lastRow = Worksheets(i).Range("L" & Rows.Count).End(xlUp).Row
        Worksheets(i).Rows(3 & ":" & lastRow).Copy _
            Destination:=Worksheets(1).Rows(dstRow & ":" & (dstRow + lastRow - 2))
        
        Worksheets(i).Rows(3 & ":" & lastRow).Copy
        Worksheets(1).Rows(dstRow & ":" & (dstRow + lastRow - 2)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        dstRow = dstRow + lastRow - 1
    Next
End Sub
id:anim130M

早急に対応いただきありがとうございました。

2011/02/28 09:31:16

その他の回答(1件)

id:taknt No.1

きゃづみぃ回答回数13538ベストアンサー獲得回数11982011/02/28 09:17:23

ポイント35pt

提示されているソースは、貼り付け先の範囲をしている箇所と 貼り付けようとしている元の範囲が

不一致となるため エラーとなります。

たとえば 4行範囲指定したところに 5行や3行を 貼り付けようとしたら

どうしたらいいのか わからないので エラーとなるのです。



貼り付け先は 先頭の行だけ指定してあげればいいのです。

Worksheets(i).Rows(3 & ":" & lastRow).Copy _

Destination:=Worksheets(1).Rows(dstRow & ":" & (dstRow))


というように。

id:anim130M

回答ありがとうございました。

2011/02/28 09:30:30
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912011/02/28 09:06:27ここでベストアンサー

ポイント250pt

セルの結合が無ければ、一回の処理でできそうですが、

最初に全体コピーした後で、数式を値としてコピーしています。

Private Sub CommandButton3_Click()
    Dim dstRow As Long
    dstRow = 3
    
    Dim lastRow As Long
    Dim i As Long
    
    For i = 3 To Worksheets.Count
        lastRow = Worksheets(i).Range("L" & Rows.Count).End(xlUp).Row
        Worksheets(i).Rows(3 & ":" & lastRow).Copy _
            Destination:=Worksheets(1).Rows(dstRow & ":" & (dstRow + lastRow - 2))
        
        Worksheets(i).Rows(3 & ":" & lastRow).Copy
        Worksheets(1).Rows(dstRow & ":" & (dstRow + lastRow - 2)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        dstRow = dstRow + lastRow - 1
    Next
End Sub
id:anim130M

早急に対応いただきありがとうございました。

2011/02/28 09:31:16
  • id:Mook
    以前回答したときには2行目が開始位置だったと思いますが、
    3行目に変更されているようですね。
    開始位置だけでなく、
      dstRow + lastRow - 2

      dstRow + lastRow - 3
    に修正してください。

    コピー間を1行空けるのであれば現状でよいですが、つめるのであれば
      dstRow = dstRow + lastRow - 1

      dstRow = dstRow + lastRow - 2
    となります。
  • id:taknt
    提示されたソースを変更する場合は、全体を理解しないと ダメですよね。
  • id:Mook
    一回調整すれば不要かもしれませんが、
    このようなときには後から一箇所変更すればよいように、パラメータかします。

    Private Sub CommandButton3_Click()
      Const SRC_StartRow = 3 '// コピー元の開始行
      Const DST_StartRow = 3 '// コピー先の開始行
      Const DST_IntervalRow = 1 '// コピー時の行間
      
      Dim dstRow As Long
      dstRow = DST_StartRow
      
      Dim lastRow As Long
      Dim i As Long
      
      For i = 3 To Worksheets.Count
        lastRow = Worksheets(i).Range("L" & Rows.Count).End(xlUp).Row
        Worksheets(i).Rows(SRC_StartRow & ":" & lastRow).Copy _
          Destination:=Worksheets(1).Rows(dstRow & ":" & (dstRow + lastRow - SRC_StartRow + 1))
        
        Worksheets(i).Rows(SRC_StartRow & ":" & lastRow).Copy
        Worksheets(1).Rows(dstRow & ":" & (dstRow + lastRow - SRC_StartRow + 1)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        dstRow = dstRow + lastRow - SRC_StartRow + DST_IntervalRow + 1
      Next
    End Sub

    行間を調整したいときは、DST_IntervalRow を変更してみてください。
    上記は1行間隔空けるようになっていますが、くっつけたい場合は 0 にします。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません