Excelのマクロで自動で一つのシートに転記したい| OKWAVE

VBAで自動で全体と分析以外のシートを全体に転記

お詳しい方宜しくお願い致します。一番初めにコードを提供して頂けた方にAmazonギフトコード3,000円提供します。急ぎでどうしてもエラーがないコードが知りたい為です。 Excelで"全体"と"分析"シート以外のシート(ここでは”A”とB”)を"全体"シートに転記したいです。(添付ファイルはAシートしか載せていません) 以下のコードをマクロで実行すると"全体"シートに集計はちゃんとされていますが、エラーが出ます。実行時エラー'1004': 'Select' メソッドは失敗しました '_Worksheet'オブジェクト最初のシートのcellsの行数カウントとシート選択部分が間違えているのが原因のようですが、コードが分からなくて・・・以下、VBAです。 ----------------------------------------------------------- Sub 複数シートのデータを1枚のシートにまとめる_シートオプションあり() '複数シートを１枚 '全体シートがあるか調べる Dim 貼付シート As Worksheet, あり As Boolean For Each 貼付シート In Worksheets If 貼付シート.Name = "全体" Then あり = True Exit For End If Next 貼付シート ' "全体"が存在しなければメッセージを表示して処理を終了 If あり = False Then MsgBox "貼り付けシートがありません。終了します。", vbInformation, "エラー" Exit Sub End If 'シートの内容クリア Worksheets("全体").Select Range("A1").CurrentRegion.Clear '各シートで処理をする Dim 枚数 As Long, シート As Worksheet 枚数 = 0 Dim 除外辞書 As Object, 対象辞書 As Object, 配列 As Variant Dim 除外配列 As Variant, 対象配列 As Variant, 数 As Long Set 除外辞書 = CreateObject("Scripting.Dictionary") Set 対象辞書 = CreateObject("Scripting.Dictionary") '除外配列に、除外対象を代入配列 = Split("全体,分析", ",") 除外配列 = 配列 For 数 = 0 To UBound(除外配列) 除外辞書.Add 除外配列(数), "除外" Next 数 'シート名が除外辞書になければ、対象辞書に加える For Each シート In Worksheets If Not 除外辞書.Exists(シート.Name) Then 対象辞書.Add シート.Name, "対象" End If Next シート '対象のキーを、配列に入れる対象配列 = 対象辞書.keys '配列に入れた対象に、順次処理をする For Each シート In Worksheets(対象配列) Call 複数シートのデータを1枚のシートにまとめる(シート, 枚数) Next End Sub Sub 複数シートのデータを1枚のシートにまとめる(シート As Worksheet, 枚数 As Long) '複数シートを１枚 Application.ScreenUpdating = False ' 画面描画を停止 Application.DisplayAlerts = False ' 警告表示を停止 Dim 右下セル As String, セル範囲 As String, 貼り付け先範囲 As Range, 貼り付け先セル As String 'シートが"全体"ではない場合、"全体"にデータを貼り付ける If シート.Name <> "全体" Then 枚数 = 枚数 + 1 'コピーする範囲を取得シート.Select Dim 最終行 As Long '表の最終行を決定最終行 = Cells(Rows.Count, Range("G5").Column).End(xlUp).Row セル範囲 = "A5" & ":" & Cells(最終行, Range("P5").Column).Address(False, False) If 枚数 = 1 Then シート.Range(セル範囲).Copy Worksheets("全体").Range("A1").PasteSpecial Paste:=xlPasteAll Worksheets("全体").Range("A1").PasteSpecial Paste:=xlPasteValues Else '表全体の末端を右下セルとして取得 Worksheets("全体").Select Range("A1").CurrentRegion.Select 右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("A1").Column).Address(False, False) 貼り付け先セル = Worksheets("全体").Range(右下セル).Offset(1, 0).Address(False, False) シート.Range(セル範囲).Offset(1, 0).Resize(Range(セル範囲).Rows.Count - 1).Copy Worksheets("全体").Range(貼り付け先セル).PasteSpecial Paste:=xlPasteAll Worksheets("全体").Range(貼り付け先セル).PasteSpecial Paste:=xlPasteValues End If End If Worksheets("全体").Activate Application.DisplayAlerts = True ' 警告表示を再開 Application.ScreenUpdating = True ' 画面描画を再開 End Sub

ＥＸＣＥＬマクロでのシート間のデータ同期方法

質問させていただきます。ＥＸＣＥＬにて、"シート１"のA1～C3と"シート２"のD4～F6を同期化したく考えております。・いわゆる一方のシートが「読み取り専用」になってしまうリンク貼り付けではなく、シート1、シート2相互が書き換え可能の同期化です。・A1とD4、B3とE6、のように互いに照合箇所のセル同士を同期反映させたいと考えております。なお、他の質問を参照したところ、シート１のA1とシート２のD4の単一セルを同期かする方法は確認できました。（以下参照） ***************************************************************** シート１のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Worksheets("シート２").Range("D4") = Target End If End Sub シート２のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$4" Then Worksheets("シート１").Range("A1") = Target End If End Sub *************************************************************** これを参考にVBAのシート１のコードエディターに Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$2" Then Worksheets("シート２").Range("D5") = Target End If End Sub シート２のコードエディターに Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$5" Then Worksheets("シート２").Range("A2") = Target End If End Sub というように追記していったのですが、エラーとなってしまいます。お詳しい方がおられましたらお願いいたします。

Excelでシート名と最終更新日を自動表示したい

Excelを使って（１）セルA1に入れた名目をシート名にし（２）セルH1には、最終更新日を自動で入れたいです。調べた結果、シート名を右クリックして「コードの表示」から（１）は Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub を入れてうまくいきましたが、（２）は Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 　If ThisWorkbook.Saved = False Then 　　Worksheets("Sheet1").Range("H1").Value = Date 　End If End Sub を入れてみましたが（←調べましたもの）うまくいきませんでした。単純に、 Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 　If ThisWorkbook.Saved = False Then 　　Worksheets("Sheet1").Range("H1").Value = Date 　End If End Sub とつなげて入れるのではだめなんでしょうか？それとも、（２）の何かが間違っていますか？ご教授願います。

EXCEL　マクロ　

お世話になります。マクロは初心者です。セルの数値を参照して、シートをアクティブにしたいのですが下記のような繰り返しでシートが30ぐらいあるので、簡単な表現に出来ないでしょうか。宜しくお願いします。 Private Sub Workbook_Open() If 0 <= Worksheets(4).Range("M1") < 7 Then Worksheets(4).Activate End If If 0 <= Worksheets(5).Range("M1") < 7 Then Worksheets(5).Activate End If If 0 <= Worksheets(6).Range("M1") < 7 Then Worksheets(6).Activate End If If 0 <= Worksheets(7).Range("M1") < 7 Then Worksheets(7).Activate End If If 0 <= Worksheets(8).Range("M1") < 7 Then Worksheets(8).Activate End If If 0 <= Worksheets(9).Range("M1") < 7 Then Worksheets(9).Activate End If End Sub

VBA マクロ　シート　転記

はじめまして。VBA初心者です。今シート１のA列1行目セルにA社、A列2行目にB社、A列3行目にC社と・・ざっと1000行程あり、それぞれB列には値があります。この値をシート２のＢ列に転記したいと思っています。ただ、毎月シートを追加していきますので、左隣のシートから転記しなければなりません。シート２の項目は同じA列とB列で構成されています。A列の値が多少前後するので、FINDを使って以下のようなプログラムを作りました。ただ、左隣のシートから転記とう内容をどうやって追加したら良いのかがわかりません。Previous　をどこかに使えばできるのかなとも思うのですが、その方法がわかりません。 Sub 転記() Dim ws As Worksheet, ws1 As Worksheet, r As Range, r1 As Range Dim LastRow As Long, i As Long, er As Long, wkey As String Set ws = Worksheets("Sheet1") Set ws1 = Worksheets("Sheet2") LastRow = ws.Range("A1").End(xlDown).Row er = ws1.Range("A1").End(xlDown).Row Set r = ws.Range("A1:A" & LastRow) For i = 1 To er wkey = ws1.Range("A" & i) Set r1 = r.Find(What:=wkey, LookIn:=xlValues, LookAt:=xlWhole) If Not r1 Is Nothing Then ws1.Range("B" & i) = r1.Offset(, 1) End If Next Set r1 = Nothing Set r = Nothing Set ws = Nothing Set ws1 = Nothing End Sub どなたか詳しいお方いらっしゃいましたら、初心者の私に教えて頂けませんでしょうか？宜しくお願いします。

マクロ初心者(；◔ิд◔ิ)オーバーフロー！！

異なるシートで一致するデータがあった場合、そのセルを選択して値貼り付けするというマクロを作りました。作ったとはいえ、教えてもらったマクロを試行錯誤して使えるようにアレンジしただけなので、なにがなんだかよくわかっていません。下記の記述でマクロを使用していましたが、突然エラーになって使用できなくなりました。。。。中身を見ると If Worksheets("master sheet").Cells(i, "BL").Value = Worksheets("請求書フォーム").Range("J1").Value Then この部分が黄色に塗りつぶされてるのですが、どこをどう直したらいいのか全くわかりません。ちなみに、ほかのファイルでも同じようなマクロを使用していますが、そちらは問題なく使用できています。なんとか教えていただけないでしょうか。よろしくお願いします！！！！ Sub こぴぺ() ' ' こぴぺ Macro Dim sheet1 As Worksheet Set sheet1 = Worksheets("請求書フォーム") sheet1.Activate Dim target As Range Dim i As Long Worksheets("請求書フォーム").Range("J1").Select For i = 1 To Worksheets("master sheet").Range("BL65536").End(xlUp).Row If Worksheets("master sheet").Cells(i, "BL").Value = Worksheets("請求書フォーム").Range("J1").Value Then If target Is Nothing Then Set target = Worksheets("master sheet").Range("BL" & i) Else Set target = Union(target, Worksheets("master sheet").Range("BL" & i)) End If End If Next i Set sheet1 = Worksheets("master sheet") sheet1.Activate If Not target Is Nothing Then target.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub

エクセルマクロで教えてください

Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。

excel　ユーザーフォームでシートごとに転記2

先日ユーザーフォームへの転記について質問させていただきました。ご回答いただき、ありがとうございました。今度はオプションボタンで選択したときに、シートごとに転記する方法を教えていただけますでしょうか。ユーザフォーム上で、オプションボタンを選択。 OptionButton1・・・シート１へ転記 OptionButton2・・・シート２へ転記これをOKボタンを押したときに転記するようにしたいと思っています。 Private Sub OK_Click() Dim CLrow As Long Dim KYrow As Long CLrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row KYrow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row If OptionButton1.Value = True Then Worksheets("Sheet1").Range("A" & CLrow).Value = .TextBox1.Value ElseIf OptionButton2.Value = True Then Worksheets("Sheet2").Range("A" & KYrow).Value = .TextBox1.Value End With End Sub ここまでやってみたのですが「参照が不正または不完全です」と出てしまいます。どなたかご教示願います。よろしくお願いします。

エクセル2003　シートを保護するとマクロエラー

sub macro1() 　worksheets("Sheet2").copy before:=worksheets(1) 　with worksheets(1) 　　.range("D4:BH14").interior.colorindex = xlnone 　　.range("D16:BH21").interior.colorindex = xlnone 　　.printout 　end with 　application.displayalerts = false 　worksheets(1).delete 　application.displayalerts = true end sub 以前に、こちらの質問で回答をいただきました。会社のプリンターは古すぎなのですが、見事！なんとか、会社のプリンターでできました。入力されたくないセルもあり、シートを保護しました。すると、マクロにエラーがかかりました。なるべく、触られたくないセルがあったり、データを入力してほしいデータもあり… セルの保護をかけながら、マクロを有効に動かしたく思います。よろしくお願いします。

【VBA】　超初心者です　複数のシートに転記したい

Sub べんきょう() Worksheets(Array(1, 3)).Select Range("A1").value = 20 End Sub もしくは Sub べんきょう() Worksheets("sheet1").Select Worksheets("sheet3").Select False Range("A1").value = 20 End Sub でやってもsheet1にしか転記されないんです！！ご指導よろしくお願いします！

EXCEL　VBA 複数シート選択の方法

エクセルVBAのシート選択方法について教えてください。選択対象シート数は4つで、シート名は、「101」「102」「103追加工」「104」とします。シート名「表紙」のセルは A1：101　A2：102　A3：103追加工　A4：104となっており、使用者はB1～B4セルに「○」「×」を入力し、「○」となっているシートのみ選択出来るようにしたい。下記マクロの場合、シート名が全角文字だと使えるのですが、シート名が「101」のように半角数字だけの場合コピーできません。どこを修正すればよいのでしょうか？ Sub TestSample2() Dim c As Range Dim flg As Boolean On Error Resume Next flg = True ThisWorkbook.Activate　 With Worksheets("表紙") 　For Each c In .Range("B1:B4") 　　If c.Value Like "○*" Then 　　　 Worksheets(c.Offset(, -1).Value).Select flg 　　　 flg = False 　　End If 　Next c End With 　With ActiveWindow.SelectedSheets 　If .Count > 0 Then 　　 .Copy 　End If 　End With 　'元のシートに戻る場合　'Application.Goto ThisWorkbook.Worksheets("表紙").Range("A1") End Sub

エクセルVBAで別シートにコピー貼り付け

VBA初心者です。下記のようにプログラムしましたがうまくいかなくて困ってます。どなたかお力をお貸しください。内容としましては輸入Partsのシートからコピーして商品内容確認のシートのセルB17に貼り付けたいです。輸入Partsシートで3列目の空白を探し同じ行の1列目をコピーします。商品内容確認のシートのセルB17にはカーソルは動いているようですが貼りつきません。 Private Sub 商品内容確認2_Click() If MsgBox("商品内容確認へ移動しますか？", 33, "移動の確認") = 2 Then MsgBox "処理を中止します。" Range("A2").Select Exit Sub End If Dim Line As String Dim Maxrow As String Worksheets("輸入Parts").Select Line = 2 Do Until Cells(Line, 1).Value = "" On Error Resume Next If Cells(Line, 3).Value = "" Then Cells(Line, 1).Copy 'コピーする Maxrow = Worksheets("商品内容確認").Range("B17").End(xlDown).Row + 1 Worksheets("商品内容確認").Range("B" & Maxrow).PasteSpecial Paste:=xlPasteValues '値を貼り付け End If On Error GoTo 0 '次の行に移り最後の行まで検索 Line = Line + 1 Loop Worksheets("商品内容確認").Visible = True Worksheets("商品内容確認").Select Worksheets("商品内容確認").Range("B6").Select Worksheets("商品内容確認").輸入Partsシート2.Visible = True Worksheets("商品内容確認").輸出Partsシート2.Visible = False Worksheets("輸入Parts").Visible = False End Sub

エクセルマクロ文を　教えてください

お世話になります。下記マクロ文で各シ－トのＶ４セル或いはＷ４セル or Ｘ４セルの値が増減値と表示されている場合には、当該シ－トは当該セル列と前２列の幅を０にする目的で記載したのですが、ステップインでは全く処理を行っていない形となっております。　初心者のため教則本を横に置いて作成したのですが所与目的を達成させる正しいマクロ文を　お教えいただけますよう御願いいたします。 Application.ScreenUpdating = False Worksheets("表紙").Visible = True Worksheets("表紙").Select Dim sht As Worksheet For Each sht In Worksheets Range("V4").Select If Range("V4").Value = "増減値" Then Range("T4:V4").ColumnWidth = 0 End If If Range("W4").Value = "増減値" Then Range("U4:W4").ColumnWidth = 0 End If Range("X4").Select If Range("X4").Value = "増減値" Then Range("V4:X4").ColumnWidth = 0 End If Next Worksheets("表紙").Activate Worksheets("表紙").Select Range("A1").Select Application.EnableEvents = True Application.Interactive = True Application.ScreenUpdating = True End Sub

マクロでキーワードを抽出して別のシートに貼り付けする

セルA列にキーワードCCCが含まれていた場合にその行を削除してSheet2に貼り付けをしたく、下記のソースを書いてみましたがエラーがでてしまいます。どこが間違っているか添削していただけないでしょうか？ Sub キーワード切取貼付() Dim r As Range For Each r In Range("A1", Range("A65536").End(xlUp)) Do Set r = Range("A:A").Find(What:=CCC, LookAt:=xlPart) If r Is Nothing Then Exit Do r.Worksheets("Sheet1").Range("A:A").Cut r.Worksheets("Sheet2").Range("A1").PasteSpecial Loop Next End Sub

エクセル　特定のシートを異なるブックの指定したシートにコピーするマクロ

エクセルの"貼り付け先.xls"の(シート名＝"集計")を開いている状態で、別の異なるブックの"貼り付け元.xls"の（シート名＝"sheet1"）の内容を全部コピーして "貼り付け先.xls"の(シート名＝"集計元データ")へ貼り付けるマクロはどのようになりますでしょうか？いろいろ調べて下記のように書きましたが、インデックスが有効範囲にありませんというメッセージが出て、デバッグを確認すると Workbooks("貼り付け元.xls").Worksheets("Sheet1").Range("A1").Copy_の部分が黄色く表示されてきます。 (１)　"貼り付け先.xls"と"貼り付け元.xls"は同じパソコンのマイドキュメントに保存されています。 (２)"貼り付け元.xls"の"Sheet1"はセルA1から入力されていて、内容は毎日変わります。 (３)Range("A1")や("A1:IV65536")のセル番地をいろいろ変えたりしても同じでした。 Sub クリップボードを経由せずにコピー貼り付けする_異なるブック() Workbooks("貼り付け元.xls").Worksheets("Sheet1").Range("A1").Copy_ Workbooks("貼り付け先.xls").Worksheets("集計元データ.xls").Range ("A1:IV65536") End Sub

マクロ　EXCELの範囲をコピーして貼付け２

【やりたいこと】エクセルファイル（test.xls）に複数のシートが存在します。（1）そのエクセルに新しいシートを1つ挿入しシート名を「統合」とつけます。（2）シート名に「時」という文字が含まれたシートにある表を範囲指定しコピー（3）「統合」シートに貼り付けます。 ※「時」という文字が含まれたシートは複数あります（不特定）【問題箇所（エラーになっている箇所）・・★】「時」という文字が含まれたシートは複数枚あるので「統合シート」に貼付ける際前に貼り付けた続きから貼り付けたいので「統合」シートの最終行を求め、貼り付けを行っていきたいのですが、最終行を求める箇所でエラーになります。度々の質問で申し訳ございませんがどなたかご教示頂けないでしょうか。よろしくお願い致します。 Sub attendanceJoin() Dim MaxRow As Integer Dim wsNewMaxRow As Integer Dim NewWorkSheet As Worksheet Dim ws As Worksheet Workbooks("test.xls").Activate Set NewWorkSheet = Worksheets.Add() '新しいシートを追加 NewWorkSheet.Name = "統合" '新しく追加したシートに「統合」と名前をつける Worksheets("統合").Range("A1").Value = "NO" 'A1のセルに「NO」と入れる For Each ws In Worksheets If ws.Name Like "*時*" Then MaxRow = Worksheets(ws.Name).Range("A4").End(xlDown).Row wsNewMaxRow = Worksheets("統合").Range("A1").End(xlDown).Row '↑★この行でエラー：最終行を求める箇所 With Workbooks("test.xls") .Worksheets(ws.Name).Range("A5:M" & MaxRow).Copy .Worksheets("統合").Range("A" & wsNewMaxRow + 1).PasteSpecial '求めた最終行の次から貼り付けする。 End With End If Next End Sub

エクセルチャート操作のマクロのエラー

エクセルマクロ初心者です。グラフの縦軸をセルの値の変化に合わせて変化するよう(対照のセルはB1とB2で変化します。)下記のマクロをネット検索してモジュールに貼り付け機能するようになったのですが、シートに保護をかけると、「実行時エラーー214767259(80004005): MaximumScaleメソッドは失敗しましたAxisオブジェクトのメッセージが出て機能しません。 Worksheet_SelectionChange(ByVal Target As Range) If Range(A1) <> "" Then Call AxesSet End Sub Sub AxesSet() Dim oChart As ChartObject Set oChart = Worksheets("Sheet1").ChartObjects(1) With oChart.Chart.Axes(xlValue, xlPrimary) .MaximumScale = Worksheets("Sheet1").Range(B1) .MinimumScale = Worksheets("Sheet1").Range(B2) .DisplayUnit = xlThousands .HasDisplayUnitLabel = False .MinorTickMark = xlInside End With End Sub 対照セルの保護の問題かと思い、セルのロックを解除したり、マクロから保護を解除するなど検索してみたのですが上手くいきません。シートを保護してもマクロが機能する解決方法お教えください。

エクセルのマクロを教えてください。

マクロの初心者です。特に変数が全く使えず、下記もどのように記載していいのかわからないため教えていただけないでしょうか。ユーザーフォームのtextbox2に開始番号があります。 textbox3に本数があります。 sheet1のB12セルには開始番号が入ります。開始番号から本数分+1したものを順番にセルに入っていくようにしたいです。ただ、入れたいセルが横→左下（開始番号の列）→横→左下（開始番号の列）・・・としたいため、どのように書いていいのかわかりません。地道に書くのであれば、下記のようになると思うのですが、変数を使って書く場合はどのようになるのか教えていただけないでしょうか。 Worksheets("Sheet1").Range("B12").Value = TextBox2.Value If TextBox3.Value = 2 Then Worksheets("Sheet1").Range("G12").Value = TextBox2.Value * 1 + 1 ElseIf TextBox3.Value = 3 Then Worksheets("Sheet1").Range("G12").Value = TextBox2.Value * 1 + 1 Worksheets("Sheet1").Range("B13").Value = TextBox2.Value * 1 + 2 ElseIf TextBox3.Value = 4 Then Worksheets("Sheet1").Range("G12").Value = TextBox2.Value * 1 + 1 Worksheets("Sheet1").Range("B13").Value = TextBox2.Value * 1 + 2 Worksheets("Sheet1").Range("G13").Value = TextBox2.Value * 1 + 3 ElseIf TextBox3.Value = 5 Then Worksheets("Sheet1").Range("G12").Value = TextBox2.Value * 1 + 1 Worksheets("Sheet1").Range("B13").Value = TextBox2.Value * 1 + 2 Worksheets("Sheet1").Range("G13").Value = TextBox2.Value * 1 + 3 Worksheets("Sheet1").Range("B14").Value = TextBox2.Value * 1 + 4 ・・・ End If

マクロでシート２～６のデータをシート１に転記したい

マクロでシート２～６のデータをシート１に転記したいです。シート２～６のデータをシート１に順番に転記したくてマクロの記録を利用して作成しました。シート２～６は列は同じですが行数は異なります。また行数は作業の都度異なります。同じ記述が繰り返されているのでもう少し記述が短くできるのではと思うのですがどうすればいいでしょうか？ Sub データ更新() 'シート１の前回データをクリア Sheets("シート１").Select Range("A2:Q2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A2").Select Sheets("シート１").Select Range("A1").Select Sheets("シート２").Select Range("A1").Select 'ヘッダーも合わせて取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート３").Select Range("A2").Select 'データのみ取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート４").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート５").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート６").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select End Sub

簡単マクロ編集

Sheets("Sheet1").Select　　←Range("A3:H8") Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 下方にこの操作を繰り返ししたいのですが Dim i As Long Worksheets("Sheet1").Select For i = 3 To 100 Step 6 If Cells(i, "A") = "" Then Exit Sub End If Cells(i, "A").Resize(6, 8).Copy Destination:=Worksheets("Sheet2").Range("A3:H8") Next i 貼付けは値で貼り付けたいと思います。どう組み合わせればよいですか？

Excelのマクロで自動で一つのシートに転記したい

質問者が選んだベストアンサー

お礼 2024/04/01 23:35

その他の回答 (1)

お礼 2024/04/01 23:40

補足 2024/04/01 21:39

関連するQ&A

VBAで自動で全体と分析以外のシートを全体に転記

ＥＸＣＥＬマクロでのシート間のデータ同期方法

Excelでシート名と最終更新日を自動表示したい

ネットワークエンジニアとは？技術職の未来を考える

EXCEL　マクロ

VBA マクロ　シート　転記

マクロ初心者(；◔ิд◔ิ)オーバーフロー！！

エクセルマクロで教えてください

excel　ユーザーフォームでシートごとに転記2

エクセル2003　シートを保護するとマクロエラー

【VBA】　超初心者です　複数のシートに転記したい

EXCEL　VBA 複数シート選択の方法

エクセルVBAで別シートにコピー貼り付け

AIは使う人の年齢や市場にも影響する？人工知能の可能性

エクセルマクロ文を　教えてください

マクロでキーワードを抽出して別のシートに貼り付けする

エクセル　特定のシートを異なるブックの指定したシートにコピーするマクロ

マクロ　EXCELの範囲をコピーして貼付け２

エクセルチャート操作のマクロのエラー

エクセルのマクロを教えてください。

マクロでシート２～６のデータをシート１に転記したい

簡単マクロ編集

注目のQ&A

カテゴリ

OKWAVE コラム

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

専門家に質問してみよう

Excelのマクロで自動で一つのシートに転記したい

質問者が選んだベストアンサー

お礼 2024/04/01 23:35

その他の回答 (1)

お礼 2024/04/01 23:40

補足 2024/04/01 21:39

関連するQ&A

VBAで自動で全体と分析以外のシートを全体に転記

ＥＸＣＥＬマクロでのシート間のデータ同期方法

Excelでシート名と最終更新日を自動表示したい

ネットワークエンジニアとは？技術職の未来を考える

EXCEL マクロ

VBA マクロ シート 転記

マクロ初心者(；◔ิд◔ิ)オーバーフロー！！

エクセルマクロで教えてください

excel ユーザーフォームでシートごとに転記2

エクセル2003 シートを保護するとマクロエラー

【VBA】 超初心者です 複数のシートに転記したい

EXCEL VBA 複数シート選択の方法

エクセルVBAで別シートにコピー貼り付け

AIは使う人の年齢や市場にも影響する？人工知能の可能性

エクセルマクロ文を 教えてください

マクロでキーワードを抽出して別のシートに貼り付けする

エクセル 特定のシートを異なるブックの指定したシートにコピーするマクロ

マクロ EXCELの範囲をコピーして貼付け２

エクセルチャート操作のマクロのエラー

エクセルのマクロを教えてください。

マクロでシート２～６のデータをシート１に転記したい

簡単マクロ編集

注目のQ&A

カテゴリ

OKWAVE コラム

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

専門家に質問してみよう

EXCEL　マクロ　

VBA マクロ　シート　転記

excel　ユーザーフォームでシートごとに転記2

エクセル2003　シートを保護するとマクロエラー

【VBA】　超初心者です　複数のシートに転記したい

EXCEL　VBA 複数シート選択の方法

エクセルマクロ文を　教えてください

エクセル　特定のシートを異なるブックの指定したシートにコピーするマクロ

マクロ　EXCELの範囲をコピーして貼付け２