戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
二つのファイルを行き来してコピペを繰り返す処理

    [191601] 二つのファイルを行き来してコピペを繰り返す処理-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(09:50))
    □U R L/
      book1に原紙になるシートが1シートあり、この原紙のシートをbook2に複数あるデータ表シートの数だけコピーして増やす。次にコピーして作った原紙のシートにbook2のデータ表のデータをコピペしていく作業をbook2のシートの数だけ繰り返す処理のコードを作成したいのですがどのように作ればいいのかわかりません。一応原紙のシートをbook2のデータシート分コピーして作成まではできたのですがここからどのように作成していけばいいか教えてください。
      よろしくお願いします。
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim ws As Worksheet
          
          Set wb1 = Workbooks("book2")
          Set wb2 = Workbooks("book1")
          
          wb1.Activate
      
           ' 現在のブックのシート数を取得
          For i = 3 To wb1.Worksheets.Count
      
              wb2.Activate
              
              wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(Worksheets.Count)
              
              Call コピペ
              
          Next
      
      End Sub
      
      Sub コピペ()
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim ws As Worksheet
          
          Set wb1 = Workbooks("book2")
          Set wb2 = Workbooks("book1")
          
          wb1.Activate
          
          For i = 3 To wb1.Worksheets.Count
              
              Range("A1:P18").Copy
              
              'wb2で作成したコピーシートのA1に貼り付け
              
              'wb2のB22とC22から最終行を取得してコピー(空欄を確認したらそこが最終行。下にまだ表記がある)
              
              'wb1のB22とC22へ貼り付け
              
              'wb1の先ほど取得した最終行の1行下から最終行までコピー(今度は記入欄がなくなったら最終行)
              
              'wb2のB124に貼り付け
      
          ’シートの名前をbook2のB3のセルの文字列に変更する
              
          Next
          
      End Sub
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191602] Re[1]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(10:03))
    □U R L/

      まずは、手作業だと、どんな手順になるか
      箇条書きで書き出してみてください。





    [191603] Re[2]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(10:24))
    □U R L/

      >マナ様

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

      手作業で行うと以下のような手順になりました。

      @book1の原紙シートをコピーしてシートの末尾に原紙のコピーを作成する
      Abook2へ移動して一番右にあるシート(最初の)を選択
      B選択したシートのA1からP17を範囲選択コピー
      Cbook1の原紙のコピーシートへ戻ってA1へ貼り付け
      Dbook2へ戻ってB22とC22から最終行まで選択。
      Ebook1へ行ってB22を選択して貼り付け
      F再度book2へ戻って先ほど範囲選択した最終行より下にあるB列「最終合計欄」の文字を確認してその1行下からBC列を最終行までコピー
      Gbook1へ行き「最終合計欄」の文字の下に先ほどのコピーを貼り付ける。
      Hbook1のシート名を現在選択しているシートのB3セルの名前に変更する
      Ibook2の左隣のシートとbook1の左隣のシートで上記作業を繰り返す




    [191604] Re[3]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(10:42))
    □U R L/

      >@book1の原紙シートをコピーしてシートの末尾に原紙のコピーを作成する

      では、1度に完成形を考えないで、順番に。
      まずは、↓こんなマクロを記述してみてください。

      1) book1の原紙シートをコピーしてシートの末尾に原紙のコピーを作成する
      2) コピーしたシートを、変数ws にセットする





    [191606] Re[4]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(10:55))
    □U R L/
      マナ様>
      回答ありがとうございます。
      >では、1度に完成形を考えないで、順番に。
      まずは、↓こんなマクロを記述してみてください。
      
      1) book1の原紙シートをコピーしてシートの末尾に原紙のコピーを作成する
      2) コピーしたシートを、変数ws にセットする
      
      こうでしょうか?
      
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim ws As Worksheet
          
          Set wb1 = Workbooks("book2")
          Set wb2 = Workbooks("book1")
          
          wb1.Activate
      
           ' 現在のブックのシート数を取得
          For i = 3 To wb1.Worksheets.Count
      
              wb2.Activate
              
              wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(Worksheets.Count)
              
              Set ws = wb2.Worksheets(Worksheets.Count)
              
          Next
      
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191607] Re[5]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(11:05))
    □U R L/
      まだ、繰り返しのことは考えないでください。
      
      For i = 3 To wb1.Worksheets.Count
      
      それと、今回は、Activateは、使用しないでください。
      その場合、どんなマクロになるか、わかりますか。
      
      >wb2.Activate
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191608] Re[6]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(11:10))
    □U R L/
      >マナ様
      
      繰り返しを外しました。
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim ws As Worksheet
          
          Set wb1 = Workbooks("製品別原材料一覧表.xlsm")
          Set wb2 = Workbooks("book1")
              
          wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(Worksheets.Count)
              
          Set ws = wb2.Worksheets(Worksheets.Count)
      
      End Sub
      
      
      >それと、今回は、Activateは、使用しないでください。
      >その場合、どんなマクロになるか、わかりますか。
      
      >>wb2.Activate
      
      処理が重たくなる、ですか?すみません、わかりません。
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191609] Re[7]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(11:21))
    □U R L/

      >wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(Worksheets.Count)

      wb1がactiveな状態で、そのマクロを実行すると
      期待通りの結果にならないことがあります。

      >wb2.Activate

      単に、削除しただけではだめです。

      どこを修正すればよいか、わかりますか。







    [191610] Re[8]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(11:27))
    □U R L/

      >単に、削除しただけではだめです。

      どこを修正すればよいか、わかりますか。

      すみません、分かりません。





    [191611] Re[9]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(11:35))
    □U R L/

      >Worksheets.Count

      では、この意味を理解していますか。




    [191612] Re[10]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(11:41))
    □U R L/

      >Worksheets.Count

      >では、この意味を理解していますか。

      シートの数を取得する、ですよね。




    [191613] Re[11]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(11:48))
    □U R L/

      >シートの数

      wb1ですか、それともwb2ですか。

      今回のように、複数ブック、負数シートを扱うときは、
      どのフックなのか、どのシートなのかを意識するようにしてください。




    [191614] Re[12]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(11:52))
    □U R L/

      >マナ様


      wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.worksheetsCount)


      >今回のように、複数ブック、負数シートを扱うときは、
      >どのフックなのか、どのシートなのかを意識するようにしてください。

      こういうふうに直すんですね?




    [191615] Re[13]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(12:00))
    □U R L/
      >マナ様
      
      すみません。こうですね。
      
      wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
          Set ws = wb2.Worksheets(wb2.Worksheets.Count)
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191616] Re[14]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(12:21))
    □U R L/
      それであっています。
      
      ブック指定を諸裏jyするとactiveなブックのシート数になります。
      
      Set ws = wb2.Worksheets(Worksheets.Count)
      
      こっちも同じですが、シートをコピーすると
      そのシートがactiveになるので、結果的に問題はないですが
      わかりやすさという意味で、明示しておくとよいです。
      ただ、ちょっとくどいので。簡潔に
      
      Set ws = Activesheet
      
      でもよいです。
      
      次は、以下の部分を追加してください。
      Activateしなければ、1行で記述できます。
      
      >Abook2へ移動して一番右にあるシート(最初の)を選択
      >B選択したシートのA1からP17を範囲選択コピー
      >Cbook1の原紙のコピーシートへ戻ってA1へ貼り付け
      
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191617] Re[15]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/14(12:42))
    □U R L/
      >次は、以下の部分を追加してください。
      >Activateしなければ、1行で記述できます。
      
      >Abook2へ移動して一番右にあるシート(最初の)を選択
      >B選択したシートのA1からP17を範囲選択コピー
      >Cbook1の原紙のコピーシートへ戻ってA1へ貼り付け
      
      ちょっとうまくいきません...
      
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim ws As Worksheet
          
          Set wb1 = Workbooks("book2")
          Set wb2 = Workbooks("book1")
              
          wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
          Set ws = wb2.Worksheets(wb2.Worksheets.Count)
          
          wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17").Copy
          
          ws.Range("A1:P17").PasteSpecial xlPasteAll
      
      End Sub
      
      
      すいません、諸事情で返信が月曜日になります。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191618] Re[16]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/14(14:52))
    □U R L/

      >ちょっとうまくいきません.

      うまくいかないとは?

      1行にできないという意味でしょうか。
      ht tp://excelvba.pc-users.net/fol2/2_8.html




    [191620] Re[17]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/16(09:10))
    □U R L/
      >マナ様
      
      1行にできました。
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim ws As Worksheet
          
          Set wb1 = Workbooks("book2.xlsm")
          Set wb2 = Workbooks("book1.xlsm")
              
          wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
          Set ws = wb2.Worksheets(wb2.Worksheets.Count)
          
          wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
              .Copy Destination:=ws.Range("A1:P17")
      
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191621] Re[18]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/16(12:58))
    □U R L/
      Dbook2へ戻ってB22とC22から最終行まで選択。
      Ebook1へ行ってB22を選択して貼り付け
      へ進もうとコードを組んだのですが
      
      'Range'メソッドは失敗しました: '_Worksheet' オブジェクト
      
      のエラーが一番下のところで出てしまいます。
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim WS As Worksheet
          Dim LastRow As Long
          
          Set wb1 = Workbooks("book2.xlsm")
          Set wb2 = Workbooks("book1.xlsm")
              
          wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
          Set WS = wb2.Worksheets(wb2.Worksheets.Count)
          
          wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
              .Copy Destination:=WS.Range("A1:P17")
          
          LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(22, 2).End(xlDown).Row
              
          'MsgBox LastRow ←ここで最終行は取れている
              
          wb1.Worksheets(wb1.Worksheets.Count).Range("B22:C & LastRow") _
              .Copy Destination:=WS.Range("B22:C & LastRow") ’ここでエラーが出る
      
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191622] Re[19]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/16(14:15))
    □U R L/
      少し考えたらできました。
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim WS As Worksheet
          Dim LastRow As Long
          
          Set wb1 = Workbooks("製品別原材料一覧表.xlsm")
          Set wb2 = Workbooks("シートのコピペ.xlsm")
              
          wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
          Set WS = wb2.Worksheets(wb2.Worksheets.Count)
          
          wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
              .Copy Destination:=WS.Range("A1:P17")
          
          LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(22, 2).End(xlDown).Row
              
          'MsgBox LastRow
              
          wb1.Worksheets(wb1.Worksheets.Count).Range("B22:C" & LastRow) _
              .Copy Destination:=WS.Range("B22:C" & LastRow)
      
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191623] Re[20]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/16(16:37))
    □U R L/
      >マナ様
      
      繰り返し以外できましたが、とある箇所でエラーが出て「rangeクラスのselectメソッドが失敗しました」となって困っています。
           
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim WS As Worksheet
          Dim LastRow As Long
          Dim GLastRow As Long
          Dim G_LastRow As Long
          Dim CountRow As Long
          Dim HLastRow As Long
          Dim H_LastRow As Long
          Dim CountRow2 As Long
          
          Set wb1 = Workbooks("book2.xlsm")
          Set wb2 = Workbooks("book1.xlsm")
              
          wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
          Set WS = wb2.Worksheets(wb2.Worksheets.Count)
          
          wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
              .Copy Destination:=WS.Range("A1:P17")
          
          LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(22, 2).End(xlDown).Row
              
          'MsgBox LastRow
              
          wb1.Worksheets(wb1.Worksheets.Count).Range("B22:C" & LastRow) _
              .Copy Destination:=WS.Range("B22:C" & LastRow)
          
          WS.Rows(LastRow + 1 & ":" & 121).Hidden = True
              
           GLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("溶媒集計").Row
           
           G_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(GLastRow, 2).End(xlDown).Row
           
           CountRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B" & GLastRow + 1, "B" & G_LastRow).Row
           
          wb1.Worksheets(wb1.Worksheets.Count).Range("B" & GLastRow + 1, "B" & G_LastRow) _
              .Copy Destination:=WS.Range("B125", "B" & CountRow + 125)
              
           HLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("廃棄物関係").Row
           
           H_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(Rows.Count, 2).End(xlUp).Row
           
           
           wb1.Worksheets(wb1.Worksheets.Count).Cells(H_LastRow, 2).Select 'ここでrangeクラスのselectメソッドが失敗しましたとエラーが出る。
           
           CountRow2 = wb1.Worksheets(wb1.Worksheets.Count).Range("B" & HLastRow + 3, "B" & H_LastRow).Row
           
          wb1.Worksheets(wb1.Worksheets.Count).Range("A" & HLastRow + 3, "E" & H_LastRow) _
              .Copy Destination:=WS.Range("A137", "E" & CountRow + 137)
         
          
              
          WS.Name = WS.Cells(3, 2).Value
          
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191624] Re[21]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/16(19:03))
    □U R L/
      >    wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
      >        .Copy Destination:=WS.Range("A1:P17")
      
      >    wb1.Worksheets(wb1.Worksheets.Count).Range("B22:C" & LastRow) _
      >        .Copy Destination:=WS.Range("B22:C" & LastRow)
      
      貼り付け先(Destination)は、左上隅の1セルだけでもよいです。
      
      
      -----
      
      >wb1.Worksheets(wb1.Worksheets.Count)
      
      何回もでてくるので、変数にセットするとよいです。
      
      例えば、こんな感じ
      
      Dim wsFrom as Worksheet
      Dim wsTo as Worksheet
      
      Set wsFrom = wb1.Worksheets(wb1.Worksheets.Count)
      Set wsTo = wb2.Worksheets(wb2.Worksheets.Count)
      
      -----
      
      > 'ここでrangeクラスのselectメソッドが失敗しましたとエラーが出る。
      
      たぶん、そのシートがactiveでないからです。
      動作確認したいのなら、以下ではだめですか。
      
      msgbox H_LastRow
      
      
      -----
      
      >CountRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B" & GLastRow + 1, "B" & G_LastRow).Row
      
      これは、何をしていますか。
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191625] Re[22]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/17(10:17))
    □U R L/
      >マナ様
      
      回答ありがとうございます。
      
      > 'ここでrangeクラスのselectメソッドが失敗しましたとエラーが出る。
      
      >たぶん、そのシートがactiveでないからです。
      >動作確認したいのなら、以下ではだめですか。
      
      動作確認したかっただけなのでmsgBoxでうまくいきました。
      
      msgbox H_LastRow
      
      >CountRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B" & GLastRow + 1, "B" & G_LastRow).Row
      
      >これは、何をしていますか。
      
      すいません。これはGLastRowとG_LastRowの範囲を取得したかったんです。
      正しくはこうでした。
      CountRow = G_LastRow - GLastRow
      
      
      
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim WS As Worksheet
          Dim LastRow As Long
          Dim GLastRow As Long
          Dim G_LastRow As Long
          Dim CountRow As Long
          Dim HLastRow As Long
          Dim H_LastRow As Long
          Dim CountRow2 As Long
          
          Set wb1 = Workbooks("book2.xlsm")
          Set wb2 = Workbooks("book1.xlsm")
              
          wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
          Set WS = wb2.Worksheets(wb2.Worksheets.Count)
          
          wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
              .Copy Destination:=WS.Range("A1")
          
          LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(22, 2).End(xlDown).Row
              
          'MsgBox LastRow
              
          wb1.Worksheets(wb1.Worksheets.Count).Range("B22:C" & LastRow) _
              .Copy Destination:=WS.Range("B22")
          
          WS.Rows(LastRow + 1 & ":" & 121).Hidden = True
              
           GLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("溶媒集計").Row
           
           'MsgBox GLastRow
           
           G_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(GLastRow, 2).End(xlDown).Row
           
           'MsgBox G_LastRow
           
           CountRow = G_LastRow - GLastRow
           
          'MsgBox CountRow
           
          wb1.Worksheets(wb1.Worksheets.Count).Range("B" & GLastRow + 1, "B" & G_LastRow) _
              .Copy Destination:=WS.Range("B125", "B" & CountRow + 125)
              
           HLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("廃棄物関係").Row
           
           H_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(Rows.Count, 2).End(xlUp).Row
           
           CountRow2 = H_LastRow - HLastRow
           
          wb1.Worksheets(wb1.Worksheets.Count).Range("A" & HLastRow + 3, "E" & H_LastRow) _
              .Copy Destination:=WS.Range("A145")
         
          
              
          WS.Name = WS.Cells(3, 2).Value
          
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191626] Re[23]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/17(12:58))
    □U R L/
      for文で繰り返しを行おうとするとうまくいきません。
      
      シートのコピーを左から右へ繰り返したいのですがうまくいきません。
      
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim WS As Worksheet
          Dim LastRow As Long
          Dim GLastRow As Long
          Dim G_LastRow As Long
          Dim CountRow As Long
          Dim HLastRow As Long
          Dim H_LastRow As Long
          Dim CountRow2 As Long
          
          Set wb1 = Workbooks("book2.xlsm")
          Set wb2 = Workbooks("book1.xlsm")
          
          For i = 3 To wb1.Sheets.Count
          
              wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
              Set WS = wb2.Worksheets(wb2.Worksheets.Count)
          
              wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
                  .Copy Destination:=WS.Range("A1")
          
              LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(22, 2).End(xlDown).Row
              
          'MsgBox LastRow
              
              wb1.Worksheets(wb1.Worksheets.Count).Range("B22:C" & LastRow) _
                  .Copy Destination:=WS.Range("B22")
          
              WS.Rows(LastRow + 1 & ":" & 121).Hidden = True
          
          
              
               GLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("溶媒集計").Row
           
           'MsgBox GLastRow
           
               G_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(GLastRow, 2).End(xlDown).Row
           
           'MsgBox G_LastRow
           
              CountRow = G_LastRow - GLastRow
           
          'MsgBox CountRow
           
              wb1.Worksheets(wb1.Worksheets.Count).Range("B" & GLastRow + 1, "B" & G_LastRow) _
               .Copy Destination:=WS.Range("B125", "B" & CountRow + 125)
              
               HLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("廃棄物関係").Row
           
              H_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(Rows.Count, 2).End(xlUp).Row
               
              CountRow2 = H_LastRow - HLastRow
           
              wb1.Worksheets(wb1.Worksheets.Count).Range("A" & HLastRow + 3, "E" & H_LastRow) _
                  .Copy Destination:=WS.Range("A145")
              
              WS.Name = WS.Cells(3, 2).Value
              
          Next
          
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191627] Re[24]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/17(13:06))
    □U R L/
      Option Explicit
      
      Sub 原紙のコピー()
      
          Dim i As Integer
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim WS As Worksheet
          Dim LastRow As Long
          Dim GLastRow As Long
          Dim G_LastRow As Long
          Dim CountRow As Long
          Dim HLastRow As Long
          Dim H_LastRow As Long
          Dim CountRow2 As Long
          
          Set wb1 = Workbooks("book2.xlsm")
          Set wb2 = Workbooks("book1.xlsm")
          
          For i = wb1.Sheets.Count To 3 Step -1 'ここを変えましたがうまくいきません
          
              wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              
              Set WS = wb2.Worksheets(wb2.Worksheets.Count)
          
              wb1.Worksheets(wb1.Worksheets.Count).Range("A1:P17") _
                  .Copy Destination:=WS.Range("A1")
          
              LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(22, 2).End(xlDown).Row
              
          'MsgBox LastRow
              
              wb1.Worksheets(wb1.Worksheets.Count).Range("B22:C" & LastRow) _
                  .Copy Destination:=WS.Range("B22")
          
              WS.Rows(LastRow + 1 & ":" & 121).Hidden = True
          
          
              
               GLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("溶媒集計").Row
           
           'MsgBox GLastRow
           
               G_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(GLastRow, 2).End(xlDown).Row
           
           'MsgBox G_LastRow
           
              CountRow = G_LastRow - GLastRow
           
          'MsgBox CountRow
           
              wb1.Worksheets(wb1.Worksheets.Count).Range("B" & GLastRow + 1, "B" & G_LastRow) _
               .Copy Destination:=WS.Range("B125", "B" & CountRow + 125)
              
               HLastRow = wb1.Worksheets(wb1.Worksheets.Count).Range("B22:B134").Find("廃棄物関係").Row
           
              H_LastRow = wb1.Worksheets(wb1.Worksheets.Count).Cells(Rows.Count, 2).End(xlUp).Row
               
              CountRow2 = H_LastRow - HLastRow
           
              wb1.Worksheets(wb1.Worksheets.Count).Range("A" & HLastRow + 3, "E" & H_LastRow) _
                  .Copy Destination:=WS.Range("A145")
              
              WS.Name = WS.Cells(3, 2).Value
              
          Next
          
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191628] Re[25]: 二つのファイルを行き来してコピペを繰り返す処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/03/17(14:08))
    □U R L/
      Sub test()
          Dim wb1 As Workbook
          Dim wb2 As Workbook
          Dim wsFrom As Worksheet
          Dim wsTo As Worksheet
          Dim i As Long
      
          Set wb1 = Workbooks("book2.xlsm")
          Set wb2 = Workbooks("book1.xlsm")
      
          For i = 3 To wb1.Sheets.Count
              Set wsFrom = wb1.Worksheets(i)
              wb2.Worksheets("原紙").Copy after:=wb2.Worksheets(wb2.Worksheets.Count)
              Set wsTo = ActiveSheet
      
              wsFrom.Range("A1:P17").Copy Destination:=wsTo.Range("A1")
              wsTo.Name = wsTo.Range("B3").Value
          Next
      
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191629] Re[26]: 二つのファイルを行き来してコピペを繰り返す処理-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ 六 -(2020/03/17(16:23))
    □U R L/

      >マナ様

      回答ありがとうございます。
      うまくいきました。
      マナ様、根気強くご指導いただき本当にありがとうございました。
      とても勉強になりました。



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G