[[20230307140220]] 『別ファイルへのコピペの繰り返し』(のぞみ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『別ファイルへのコピペの繰り返し』(のぞみ)

    Workbooks("Book1.xlsm").ActiveSheet.Range(ActiveCell, ActiveCell.Offset(15, 3)).Copy

    ActiveCell.Offset(0, 4).Select

    Workbooks("Book2.xlsx").ActiveSheet.Activate

    Range("D3").Activate

    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ActiveCell.Offset(19, 0).Select

    Workbooks("Book1.xlsm").Activate

    Workbooks("Book1.xlsm").ActiveSheet.Range(ActiveCell, ActiveCell.Offset(15, 3)).Copy

    ActiveCell.Offset(0, 4).Select

    Workbooks("Book2.xlsx").ActiveSheet.Activate

    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ActiveCell.Offset(19, 0).Select

上記の操作をBook1のコピー元がなくなる(空白になる)まで繰り返し行いたい場合の構文を教えて下さい。

初心者なのでくどく書いているのはご容赦ください・・・

以上、宜しくお願い致します。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 参考HPです。

https://excel-ubara.com/excelvba1/EXCELVBA317.html
(MK) 2023/03/07(火) 14:12:15


    Dim i As Integer

    Workbooks("Book1.xlsm").ActiveSheet.Range(ActiveCell,   ActiveCell.Offset(15, 3)).Copy

    ActiveCell.Offset(0, 4).Select

    Workbooks("Book2.xlsx").ActiveSheet.Activate

    Range("D3").Activate

    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ActiveCell.Offset(19, 0).Select

    Workbooks("Book1.xlsm").Activate

    For i = Range("C1").Value To Range("JS1").Value

    Workbooks("Book1.xlsm").ActiveSheet.Range(ActiveCell, ActiveCell.Offset(15, 3)).Copy

    ActiveCell.Offset(0, 4).Select

    Workbooks("Book2.xlsx").ActiveSheet.Activate

    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ActiveCell.Offset(19, 0).Select

    Workbooks("Book1.xlsm").Activate

    Next

End sub

1行目(C〜JS)に管理番号(1〜70)が振られているので見様見真似でやってみましたが
最後の終わり方が分からず、ループしてしまいます。

どなたかご教授お願いします

(のぞみ) 2023/03/07(火) 15:02:41


  Sub Sample()
    Dim moto As Range
    Dim saki As Range
    Dim lc As Long
    Dim i As Long

    Set moto = Workbooks("Book1.xlsm").ActiveSheet.Range("C1")
    Set saki = Workbooks("Book2.xlsx").ActiveSheet.Range("D3")
    lc = (moto.Worksheet.Cells(moto.Row, Columns.Count).End(xlToLeft).Column - moto.Column + 1) \ 4

    For i = 0 To lc
      saki.Offset(i * 19, 0).Resize(16, 4).Value = moto.Offset(0, i * 4).Resize(16, 4).Value
    Next

  End Sub

研究用に使ってください。
(ふなば) 2023/03/07(火) 15:39:15


 For Nextループの部分以降が問題で、
 その直前までは正常な結果になっているんですか?

(半平太) 2023/03/07(火) 15:42:19


ふなばさん、ありがとうございます。

半平太さん、最後止まらない以外はやりたいことは出来ています
(のぞみ) 2023/03/07(火) 15:48:41


For i = 2 To 70
にしたら処理できました!

ちなみにもう少し簡略化することは出来ますでしょうか?
(のぞみ) 2023/03/07(火) 16:47:37


 Sub Sample()
   Dim i As Integer
   'Book2.xlsxをアクティブにする
   Workbooks("Book2.xlsx").Activate
   '(Book2.xlsxの)D3セルをアクティブにする
   Range("D3").Activate
   'Book1.xlsmをアクティブにする
   Workbooks("Book1.xlsm").Activate
   '(Book1.xlsmの)C1セルをアクティブにする
   Range("C1").Activate

   '70回繰り返す
   For i = 1 To 70
     'Book1.xlsmをアクティブにする
     Workbooks("Book1.xlsm").Activate
     'アクティブセルから16行×4列コピー
     Range(ActiveCell, ActiveCell.Offset(15, 3)).Copy
     '4列右のセルを選択する
     ActiveCell.Offset(0, 4).Select

     'Book2.xlsxをアクティブにする
     Workbooks("Book2.xlsx").Activate
     'アクティブセルを基準にコピーされた範囲を値貼り付け
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     '19行下のセルを選択する
     ActiveCell.Offset(19, 0).Select
   Next
 End Sub

元コードを生かす形の研究コードです

(ふなば) 2023/03/07(火) 17:51:40


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.