ExcelVBA シートコピー

質問

ExcelVBAで管理表1のシート１へ管理表２のシート２へコピーするVBAを書いてみました。

以下部分を修正したいです。
wbSaki.Worksheets("シート２").Range("A1:VA3000").Copy
こちらの選択範囲を最終行と最終列という風にしたいのですが、うまくコピー貼り付けができないので理由がわかる方がいらっしゃれば教えていただけますでしょうか。

以下全体コード------------------
Sub 管理表１のシート１を管理表２のシート２へを貼り付け() '選択したファイルを取り込み、別のファイルに貼り付ける。

Dim RC As Integer
Dim OpenFileName, fileName, Path, SetFile As String
Dim wbMoto, wbSaki As Workbook

Set wbMoto = ThisWorkbook 'マスターデータ取り込み元をセット

Application.DisplayAlerts = False
Application.ScreenUpdating = False 'BOOKを開かない

RC = MsgBox("管理表1を開きますか？", vbYesNo + vbQuestion, "確認")

If RC = vbYes Then

'サーバー指定　End Withまで
With CreateObject("WScript.Shell")
strCdir = CurDir
.currentdirectory = "ファイル格納先"

OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
'ダイアログボックスを表示して、マスターデータファイルを指定します。

If OpenFileName <> "False" Then
SetFile = OpenFileName
Else
MsgBox "キャンセルされました"
Exit Sub 'マスターデータの取り込みをキャンセル
End If
End With

Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0
'ダイアログボックスで指定したマスターデータファイルを開きます。

'VBA起動BOOKのシートをクリア
wbMoto.Worksheets("シート1").Cells.Clear

Set wbSaki = Workbooks.Open(Path & SetFile)

'--- オートフィルタをクリアする ---'
If wbSaki.Worksheets("シート２").FilterMode Then wbSaki.Worksheets("シート２").ShowAllData

'ワークブック間のシートをコピーします。
wbSaki.Worksheets("シート２").Range("A1:VA3000").Copy

wbMoto.Worksheets("シート１").Range("A1").PasteSpecial xlPasteValues

Application.CutCopyMode = False 'コピー切り取りを解除
wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる
Application.ScreenUpdating = True 'BOOKを開かずに作業

Else

MsgBox "処理を中断します"

End If

ThisWorkbook.Worksheets("元のシート").Select 'シート名を指定
Application.DisplayAlerts = True
End Sub

回答No.2

imogasi · ベストアンサー

コードだけコピペして、忙しい人も居る読者に読ませて、回答をくれとは？
やっていることや、したいことを、エクセルや、VBAの言葉で（用語を使って）を文章で表す練習をすること。
用例集などを読まないと、これができない。
なぜかと言うと、これができないと、WEBの関連記事や本の関係個所（目次や索引を調べるにも）がどこか、判らないので、勉強をしようにも、できない。
これが普通は訓練すると、数行の文章で表せる場合がほとんどだ。
本件は
（１）フィルタ―を使っているのか？コードではよく判らないが？
（２）その結果の可視セル(シートで見えているデータ）をコピーしたのシートやセル範囲に
張り付ける
「可視セル」というのが、エクセルの術語だ。
という課題は、WEBに記事があるはず。
ーー
「VBA フィルタ―　結果　可視セル　貼り付け」でGoogleで照会すると、記事が出る。
http://officetanaka.net/excel/vba/tips/tips155c.htm
＞CurrentRegionプロパティを使います
この件（点）は、勉強してないと、おもいつかないわね。
ーー
表題だけ読むと、初めは
Sub test01()
rowa = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
MsgBox rowa
End Sub
Sub test02()
rowa = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox rowa
End Sub
の問題かと思ったが、可視セルという点で、違った方法を要する。

回答No.1

SI299792

プログラムを見る限り、１ファイル開いてコピペするだけの様です。
動作確認していないのですが ｢シート1｣半角 ｢シート１｣ 全角が混在します。それが原因では？
.currentdirectory は私の環境では動きませんでした。大文字に変換されていないという事は、貴方の環境でも動かないのでは？
https://xtech.nikkei.com/it/atcl/column/15/090100207/090100082/
￥￥（半角だと\ になるので全角にしてあります）を付けないといけないのではないですか。

貴方のプログラムは長すぎて理解できないので、新規作成しました。
使っている範囲だけコピペするのですね。
Option Explicit
'
Sub Macro1()
　　Const ISheet = "シート２"
　　Dim Address As String
'
　　Sheets("シート１").Select
　　ChDir "\\ファイル格納先" 'この行は動作未確認
　　Address = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
'
　　If Address = "False" Then
　　　　End
　　End If
　　Cells.ClearContents
　　Application.ScreenUpdating = False
　　Workbooks.Open Address, False, True
　　On Error Resume Next
　　Sheets(ISheet).AutoFilterMode = False
'
　　If Err = 9 Then
　　　　MsgBox ISheet & "がありせん", vbCritical
　　　　End
　　ElseIf Err <> 0 Then
　　　　MsgBox Error(Err), vbCritical
　　　　End
　　End If
　　Address = Sheets(ISheet).UsedRange.Address
　　ActiveWorkbook.Close False
End Sub

お礼

早い回答ありがとうございます。インターネットにあった例文を合わせてみただけなので、長文となってしまいました。回答いただいたプログラムで試してみます。ありがとうございます。