• 締切済み

VBAでB3からLの最終入力までコピー仕方について

現在、コピー元を"B3:L244"で指定していますが、 B3からL列の最後に書かれている範囲内でコピー出来る様にしたいのですが教えて頂けないでしょうか。 Private Sub CommandButton1_Click() Dim RC As Integer Dim OpenFileName, fileName, Path, SetFile As String Dim wbMoto, wbSaki As Workbook Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット Application.DisplayAlerts = False RC = MsgBox("マスターデータ取込みますか?", vbYesNo + vbQuestion, "確認") If RC = vbYes Then OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 'ダイアログボックスを表示して、マスターデータファイルを指定します。 If OpenFileName <> "False" Then SetFile = OpenFileName Else MsgBox "キャンセルされました" Exit Sub 'マスターデータの取り込みをキャンセル End If Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'ダイアログボックスで指定したマスターデータファイルを開きます。 Set wbSaki = Workbooks.Open(Path & SetFile) 'ワークブック間のシート「項目」をコピーします。 wbSaki.Worksheets("Sheet1").Range("B3:L244").Copy wbMoto.Worksheets("1月").Range("B2").PasteSpecial xlPasteValuesAndNumberFormats Application.CutCopyMode = False 'コピー切り取りを解除 wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる Else MsgBox "処理を中断します" End If Application.DisplayAlerts = True End Sub

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.4

シート1にコマンドボタンを張り付けるとして Private Sub CommandButton1_Click() With Worksheets("Sheet1") lr = .Range("L100000").End(xlUp).Row .Range("c3:L" & lr).Copy Worksheets("Sheet2").Range("b3") End With End Sub これだけのことじゃないか?VBAでまず必要になる lr = .Range("L100000").End(xlUp).Row  が判らないのか? 初心者ならいきなりコードでなく、疑問点を、もっと文章で書くべきだと思うが。 ファイル関係の部分は略。

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.3

No2の訂正です。 With wbSaki.Worksheets("Sheet1") .Range(.Cells(3, "B"), .Cells(Rows.Count, "L").End(xlUp)).Copy End With

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.2

wbSaki.Worksheets("Sheet1").Range(Cells(3, "B"), Cells(Rows.Count, "L").End(xlUp)).Copy で試してみてください。 また Dim OpenFileName, fileName, Path, SetFile As String Dim wbMoto, wbSaki As Workbook ですが、Asが最後の変数にしかないので型の適用は最後の変数だけになります。 Dim wbMoto As Workbook, wbSaki As Workbook のようにそれぞれの変数に型を指定したほうがいいと思います。

回答No.1

セレクトまでのサブルーチンを作ってみた。 Sub B3からL最終セレクト() Dim 最終セル As Long 最終セル = Cells(Rows.Count, 12).End(xlUp).Row Range(Cells(3, 2), Cells(最終セル, 12)).Select End Sub

関連するQ&A

  • ExcelVBA シートコピー

    ExcelVBAで管理表1のシート1へ管理表2のシート2へコピーするVBAを書いてみました。 以下部分を修正したいです。 wbSaki.Worksheets("シート2").Range("A1:VA3000").Copy こちらの選択範囲を最終行と最終列という風にしたいのですが、うまくコピー貼り付けができないので理由がわかる方がいらっしゃれば教えていただけますでしょうか。 以下全体コード------------------ Sub 管理表1のシート1を管理表2のシート2へを貼り付け() '選択したファイルを取り込み、別のファイルに貼り付ける。 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("シート2").FilterMode Then wbSaki.Worksheets("シート2").ShowAllData 'ワークブック間のシートをコピーします。 wbSaki.Worksheets("シート2").Range("A1:VA3000").Copy wbMoto.Worksheets("シート1").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

  • 【VBA】一番初めの処理に戻って、処理を繰り返す。

    VBA初心者です。 コードはネットで調べて組み合わせて作っております。 今回は、組み合わせたコードで処理が終わってもフォルダ内のファイル数の数だけ処理を繰返したいです。 事前に作っているコードは、 ①データ読み取りをしたいExcelを開く、別ブックを開いて該当のセルに入力。セル自体に数式が入っているので各シートに反映されます。 ②inputboxで各シートの該当セルに表示させたい文字を入力。 ③3、4枚目のシートを選択。 ④名前をつけて保存する。 という作業のコードになっています。 ①~④までを行った後に、データ数に応じて処理を繰返し行いたいです。 下記のコードにしたところ、Nextに対応するForがありません。とエラーが出ます。End Ifは追加しているのにエラーが起きるのはなぜでしょうか? ---下記 コード--- Sub マスターデータ取込03() '選択したファイルを取り込み、別のファイルに貼り付ける。 For Each f In fso.GetFolder(folderpath).Files If fso.GetExtensionName Like "xls?" Then Set wb = Workbooks.Open(f) Dim RC As Integer Dim OpenFileName, FileName, Path, SetFile As String Dim wbMoto, wbSaki As Workbook Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット Application.DisplayAlerts = False RC = MsgBox("マスターデータ取込みますか?", vbYesNo + vbQuestion, "確認") If RC = vbYes Then OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 'ダイアログボックスを表示して、マスターデータファイルを指定します。 If OpenFileName <> "False" Then SetFile = OpenFileName Else MsgBox "キャンセルされました" Exit Sub 'マスターデータの取り込みをキャンセル End If Workbooks.Open FileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'ダイアログボックスで指定したマスターデータファイルを開きます。 Set wbSaki = Workbooks.Open(Path & SetFile) 'ワークブック間のシート「項目」をコピーします。 wbSaki.Worksheets("内訳書").Range("D:O").Copy wbMoto.Worksheets("見積入力").Range("U7").PasteSpecial xlPasteValues Application.CutCopyMode = False 'コピー切り取りを解除 wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる Else MsgBox "処理を中断します" End If Application.DisplayAlerts = True Dim ans As String ans = InputBox("見積書・請求書No", "", "") If ans <> "" Then wbMoto.Worksheets("見積").Range("I3").Value = ans Worksheets("見積").Range("I3").Value = "VHM-" & ans End If Application.DisplayAlerts = True ans = InputBox("見積書発行日", "", "") If ans <> "" Then wbMoto.Worksheets("見積").Range("F11").Value = ans End If ans = InputBox("完工日", "", "") If ans <> "" Then wbMoto.Worksheets("請求").Range("F11").Value = ans End If ans = InputBox("請求書発行日", "", "") If ans <> "" Then wbMoto.Worksheets("請求").Range("F12").Value = ans End If Worksheets(Array(2, 3)).Select ' 1 番目と 2 番目のシートを選択 Dim xFile xFile = Application.GetSaveAsFilename( _ FileFilter:="Excelファイル, *.xlsm") If TypeName(xFile) <> "Boolean" Then ActiveWorkbook.SaveAs FileName:=xFile End If Next End Sub

  • 開いているブックをバックアップ後閉じる方法

    開いているマクロブックのバックアップを実行すると、開いているマクロブックは閉じられ、バックアップファイルが作成されるまではいいのですが、バックアップファイルが開いたままになります。 出来ればバックアップファイルも閉じるようにしたいのですが、何を追記すればよいでしょうか? Sub バックアップ() Dim rc As Long rc = MsgBox("バックアップしますか?", vbYesNo + vbQuestion, "確認") If rc = vbYes Then Application.DisplayAlerts = False ActiveWorkbook.SaveAs "C:\excel\" & Format(Date, "yyyymmdd") & ".xlsm" Application.DisplayAlerts = True End If End Sub

  • VBAで、ExcelシートにCSVファイルのデータを取り込みたいのです

    VBAで、ExcelシートにCSVファイルのデータを取り込みたいのですが、 1行目しか取り込めません。 取り込む項目数は32個です。 以下のコードでは、Excelシートの1行目のみ取り込みができますが、 1行目32列目のセルには、2行目のA列に表示されるべきデータも表示されます。 2行目以下は取り込みできていません。 Sub CSV取込() Dim OpenFileName As String Dim MyString As String Dim MyVar As Variant Dim i As Long, j As Long OpenFileName = Application.GetOpenFilename("CSVファイル,*.csv") If OpenFileName = "False" Then MsgBox "キャンセルされました。" Else Open OpenFileName For Input Access Read As #1 i = 1 While Not EOF(1) Line Input #1, MyString MyVar = Split(MyString, ",") If MyVar(0) <> "" Then For j = 0 To 31 ThisWorkbook.ActiveSheet.Cells(i + 10, j + 1) = MyVar(j) Next j i = i + 1 End If Wend Close #1 End If End Sub おそらく、改行が判別できないためかと思いますが、 どこが間違っているのかがわかりません。 アドバイスをよろしくお願いします。

  • エクセルVBA、入力しないと閉じないInputBox

    必ず何かを入力しないと閉じないInputBoxを作ろうと思います。 以下のコードで入力がなければ閉じないというか、Line:に戻るので、何度でも現れるInputBoxになるようですが、このやり方は正しいですか? 通常はどうやるのでしょうか? Sub test() Dim a line: a = Application.InputBox("必ず入力して下さい。", "Input!") If Len(a) = 0 Or a = False Then GoTo line MsgBox "有難う。" & a & " ですね。", , "(o。_。)oペコッ" End Sub

  • エクセルマクロで列を削除したい

    エクセル2013です。 マクロの途中で列を削除するようにしてあります。 A列~J列、N列~Q列、T列~U列、W列~Y列を一括削除なのですが A列~J列だけは、作業者が選択した1列だけを残して削除をしたいです。 マウスで選択させて、列を指定する所までは作成できましたが 列削除の部分(★の部分)が 思うように作成できず完成できません。 アドバイスをお願いいたします。 Sub 列削除() Dim マウス選択 Dim 選択列 Dim 選択月表示 Dim 質問 On Error GoTo myError 'INPUT-BOXでキャンセルを選択した時の回避 Set マウス選択 = Application.InputBox("回覧用に編集したい月の列を選択してください", Type:=8) If マウス選択.Columns.Count > 1 Then '選択したしたのが列で有り1列であるか確認 MsgBox "選択したのは列ではありません。又は2列以上を選択しています" MsgBox "プログラムを中断します" Application.DisplayAlerts = False Application.DisplayAlerts = True Exit Sub 'プログラム停止 End If If マウス選択.Rows.Count > 1 Then '選択したのが行又はセルの場合の処理 Else MsgBox "行又はセルを選択しています。1列を選択してください" MsgBox "プログラムを中断します" Application.DisplayAlerts = False Application.DisplayAlerts = True Exit Sub 'プログラム停止 End If Set マウス選択 = マウス選択.EntireColumn Debug.Print マウス選択.Address 選択列 = マウス選択.Column 'INPUT-BOXで選択した列を数字に置き換える 選択月表示 = Cells(2, 選択列).Value '選択した列の8行目のセルの値を格納 If 選択列 > 10 Then '選択したのが11列以上の場合の処理 MsgBox "11列目以降は選択できません" MsgBox "プログラムを中断します" Application.DisplayAlerts = False Application.DisplayAlerts = True Exit Sub 'プログラム停止 End If 質問 = MsgBox("選択した月は " & 選択月表示 & " です。いいですか?", vbYesNo) If 質問 = vbYes Then MsgBox "処理を行います" '不要列削除 ★ Union(Columns("A:J"),Columns("N:Q"), Columns("T:U"), Columns("W:Y")).Delete Else MsgBox "プログラムを中断します" Application.DisplayAlerts = False Application.DisplayAlerts = True Exit Sub 'プログラム停止 End If Exit Sub 'エラーが出なかった時のmyErrorの回避用 myError: 'INPUT-BOXでキャンセルを押した時の処理 MsgBox "キャンセルが押されました。プログラム終了します。" Application.DisplayAlerts = False Application.DisplayAlerts = True Exit Sub End Sub

  • VBAで別ブックからの貼付

    XP、EXCEL2007を使用しています。 元ファイル(A)からVBAで他のブック(B)を開き、A~CK列データをコピー後 ファイル(A)のA~CK列に貼り付けるコードを作りました。 しかし下記の★がついている2行がエラーでうまくいきません。 改善するにはどうすれば良いかご教授下さい。 色々調べながらくっつけたコードですので、 だいぶ問題があると思います。 エラーコードは 「オートーメーションエラーです。」 「致命的なエラーです。」 Sub DATEOPEN() Dim OpenFileName As Variant With CreateObject("WScript.Shell") .CurrentDirectory = "\\Landisk\disk\テスト\" End With OpenFileName = Application.GetOpenFilename("xlsファイル (*.xls),*.xls", 1, "ファイルを選択") If OpenFileName <> "False" Then If Trim(Dir(OpenFileName)) = "" Then Call MsgBox("ファイルが見つかりません", vbOKOnly, "確認") Else Workbooks.Open OpenFileName ★ActiveSheet.Range("A:CK").Copy _ ★ThisWorkbook.Worksheets("データ貼付").Range("A:CK") ActiveWorkbook.Close Range("A:CK").Select ActiveSheet.Paste ActiveWorkbook.Saved = True Application.CutCopyMode = False End If End If End Sub

  • ユーザーフォームがシートの裏に隠れてしまう

    ブックを開いた時に、表示されるユーザーフォームが作業シートの裏に隠れて、作業が思うようにできません。なんとかシートの前面に表示させたいです。EXCEL365solo,WINDOWS10使用の超初心者です。ご指導よろしくお願いします。 Private Sub CommandButton96_Click() Dim OpenFileName As String Unload Me ChDir Application.ThisWorkbook.Path & "\2年集計" OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsm") G給与入力.Show vbModeless If OpenFileName <> "False" Then Workbooks.Open OpenFileName Else MsgBox "キャンセルされました" End If End Sub

  • worksheetsの名前変更マクロ

    マクロでsheetsをコピーしてそのあと名前を変更するマクロを作っているのですがうまくいきません。 マクロで他のbookを開いて、そのbook名をsheets名にしたいのですが以下のマクロではうまくいきませんでした。どこが悪いのでしょうか? ご指導お願いいたします。 Sub ~() OpenFileName = Application.GetOpenFilename("TXT/CSVファイル,*.txt?;*.csv?") ThisWorkbook.Activate Application.ScreenUpdating = False If OpenFileName <> "False" Then Set TargetBook = Workbooks.Open(OpenFileName) ThisWorkbook.Activate Worksheets("マクロ用名称変更不可").Copy before:=Worksheets("マクロ用名称変更不可") ActiveSheet.Name = OpenFileName TargetBook.Close Application.ScreenUpdating = True Else MsgBox "キャンセルしました" End If End Sub

  • Excel VBAでのシートの削除について

    Excel VBAで、シート上に配置されたボタンをクリックすることで、メッセージを出さずにそのシートの削除をしたいと思っています。 サンプルとして、シート上(例えばSheet1)にボタンを1個配置し、 ------------------------------------------------------- Private Sub CommandButton1_Click() Application.DisplayAlerts = False Delete Application.DisplayAlerts = True End Sub ------------------------------------------------------- のようにすると、オートメーションエラーが起きます。 そこで、 Application.DisplayAlerts = True をコメントアウトしてやれば実行はできるのですが、その後別のシートで処理を行う場合には、再度メッセージを表示してほしいと思っています。 ためしに、Sheet1削除後にアクティブになるSheet2に次のようなコードを記述しました。Sheet1同様、シート上にボタンを1個配置しています。 ------------------------------------------------------- Private Sub CommandButton1_Click() MsgBox Application.DisplayAlerts End Sub Private Sub Worksheet_Activate() MsgBox "次に出るメッセージはアクティブ直後のDisplayAlerts設定。" MsgBox Application.DisplayAlerts Application.DisplayAlerts = True MsgBox "次に出るメッセージは変更後のDisplayAlerts設定。" MsgBox Application.DisplayAlerts End Sub ------------------------------------------------------- こうすれば、Sheet1削除後、アクティブになった直後はDisplayAlertsがFalse。その後設定変更してTrueになるかとおもったのですが、結果はFalseでした。しかしその後、ボタンをクリックするとTrueが返ってきました。 いろいろ調べましたが、なぜこのような結果になるのかわかりません。よろしくお願いいたします。

専門家に質問してみよう