VBA：フィルターで抽出したデーターを別ブックに貼り付け

Question

前提・実現したいこと

VBAの事が全く解っていないので意味不明な事を言ってるかもしれませんが宜しくお願い致します。

Book1（商品管理）にある（一覧）というsheetにAからAGまでデーターが入って有り（空白が所々あるうえ毎日追加していきます）
フィルターで抽出したデーターを別ブックBook2（移動伝票）の（移動データー）というsheetの既存データの下に今回抽出したデータを追記していきたいのですが貼り付けがうまくいきません。

Set FromRng = .Range(Range("A8"), Cells(Rows.Count, 33).End(xlUp))の所でエラーが出ていて
抽出したデーターをコピーする時のコピー指定がおかしいのでしょうか？

色々自分なりに調べて組み合わせたコードなので変な箇所など多々あると思いますが宜しくお願い致します。

発生している問題・エラーメッセージ

・アプリケーション定義またはオブジェクト定義のエラーです。

該当のソースコード

Private Sub CommandButton1_Click()

Unload UserForm2

Application.ScreenUpdating = False

Dim clm As Range
Dim id As Range
Dim i As Long
Dim stTestFile As String

stTestFile = "C:¥新しいフォルダー¥移動伝票.xlsx"

With ThisWorkbook.Worksheets("一覧")
    Set clm = .Range(.Cells(8, 31), .Cells(.Rows.Count, 31).End(xlUp))
    Set id = clm.Find(What:="未", lookat:=xlWhole)
End With

Workbooks.Open Filename:=stTestFile
    If ActiveWorkbook.ReadOnly Then
    
        MsgBox "他の人が使用中です。"
        ActiveWorkbook.Close
    Else
    
    If Not id Is Nothing Then
                
     With ThisWorkbook.Worksheets("一覧")
        .Range("A7").AutoFilter 31, "未"
        .Range("A7").AutoFilter 8, "卯"
     End With

    Dim FromRng As Range
     With ThisWorkbook.Worksheets("一覧")
       ** Set FromRng = .Range(Range("A8"), Cells(Rows.Count, 33).End(xlUp))**
     End With

    Dim wb As Workbook
    Dim ToRange As Range
    
    Set wb = Workbooks.Open(Filename:=stTestFile)
    Set ToRange = wb.Worksheets("移動データー").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
       
    ToRange.Value = FromRng.Value
   
    Else
       MsgBox "転記するデーターはありません。"
          
     End If
    End If
    
     ThisWorkbook.Worksheets("一覧").Activate
      For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      　Cells(i, 31) = Replace(Cells(i, 31), "未", "済")
    　Next i

  　Sheets("一覧").Range("A7").AutoFilter 1
    ActiveSheet.ShowAllData
    
     Cells(Rows.Count, 1).End(xlUp).Select
     ActiveWindow.ScrollColumn = 7
    
    ActiveWorkbook.Save
    
    Workbooks("移動伝票.xlsx").Close
    
    Application.CutCopyMode = False
        
    Application.ScreenUpdating = True
 
 UserForm2.Show

End Sub

試したこと

Comments

[meg_]

「貼り付けがうまくいきません。」だけでは状況が分かりません。「何」が「どう」うまくいかないのか具体的に記述した方が回答がつくかと思います。

[yuuskeccho]

[F8]でステップ実行して、どこからどのようにうまくいかなくなるかぐらい提示できませんか？
回答者は実際のデータは推測するところから始めなければならないので

[uuyyss]

すみません、ご指摘ありがとうございます。。
コードの意味すらよく解っていないのであれですが、
Set FromRng = .Range(Range("A8"), Cells(Rows.Count, 33).End(xlUp))
の所でエラーが出ています。

抽出や他ブックを開いたりは出来ているようですがコピーする時のコピー指定がおかしいのでしょうか？
すみませんが宜しくお願い致します。

Answer 1

基本複数シートを扱うときはどのシートのRangeか、Cellsか指定しなければいけないので。
Sheets("Sheet1").Range(Sheets("Sheet1").Cells(2, 5), Sheets("Sheet1").Cells(10, 20)).
のようになります。

一度　With End With　使う前に

Dim Wh As Worksheet
Set Wh = ThisWorkbook.Worksheets("一覧")

Dim m_Wb As Workbook
Dim m_Wh As Worksheet
Set m_Wb = Workbooks.Open(Filename:=stTestFile)
Set m_Wh = m_Wb.Worksheets("移動データー")

として
Set FromRng = Wh.Range(Wh.Range("A8"), Wh.Cells(Wh.Rows.Count, 33).End(xlUp))
Rows.Countは一律なのでWhなくてもよいかな

各Range,Cellsがどのシートを扱いたいのか書いてみたら理解早いかも

Comments

[uuyyss]

そうだったのですね。早速試して解決致しました。
本当に助かり大変勉強になりました。ありがとうございます

Answer 2

エラーが出たのはどこのコードかを提示してください。

とりあえず目についたのは、下記。

            With ThisWorkbook.Worksheets("一覧")
                Set FromRng = .Range(Range("A1"), Cells(Rows.Count, 9).End(xlUp))
            End With

.（ドット）が足らない。

            With ThisWorkbook.Worksheets("一覧")
                Set FromRng = .Range(.Range("A1"), .Cells(Rows.Count, 9).End(xlUp))
            End With