プロが教えるわが家の防犯対策術!

マクロを勉強中のものです。
会社のパソコンでは外部サイトへのアクセスが禁止されており作成中のvbaをこちらに貼らず、文面でのご説明になりますことをお許しください。
やりたいことは以下の通りです。

(前提)
・全てのブックが入っているフォルダ
→2022上表彰集計作業
・データを集約したいブック〈シート名〉
→2022上表彰集計ファイル〈★TEST〉
・元データのブック〈シート名〉(取得したい範囲)
→元データ1〈テストシート〉(A8からF最終行)
元データ2〈テストシート〉(A8からF最終行)
 元データ3〈テストシート〉(A8からF最終行)
....以下10ブック程度
(やりたいこと)
・2022上表彰集計作業フォルダに入っている元データのブック全ての特定のシートの特定の範囲を、2022上表彰集計ファイルの★TESTシートのA12を開始位置として値貼り付けしたい。
順番は不動で構わないのですが、全てのデータがからならないように表にして行くのに躓いています。

「2022上表彰集計ファイル(This work book)と同じフォルダ内のxlsxファイルをすべて開き、特定のシートの特定の範囲をコピーして、2022上表彰集計ファイルのA12から値貼けと順を追っているつもりなのですが…

文章での説明なので伝わりにくかったらすみません。
一部でも構いませんので例文などいただけますと嬉しいです。
よろしくお願いします。

質問者からの補足コメント

  • おっしゃる通り、重ならないようにの誤入力です。

    データが重複しないように、というよりは、ひとつ目のファイルから集計ファイルの1行目〜10行目に転記できたとして、次はその次の行から貼り付けるようにしたいという意味でした。
    ひとつ目のファイルから転記したデータがふたつ目のファイルからのデータに上書きされないように、と。

    ありがとうございました。

    No.2の回答に寄せられた補足コメントです。 補足日時:2022/09/28 21:06
  • ありがとうございます!
    細かい部分を自分の希望に合わせて調整すれば上手くできそうです。
    補足ですが、この内容でコピーしたデータを値だけ貼り付けたいのですが、可能であればご教授ください。

    No.4の回答に寄せられた補足コメントです。 補足日時:2022/09/29 11:47
  • ありがとうございます。動かした際に元々集計シートにあったA列からE列の関数が消えるので、勘違いしてしまいました。申し訳ありません。
    おっしゃる通り、rangeで値貼り付けになっていました。失礼いたしました。

    No.6の回答に寄せられた補足コメントです。 補足日時:2022/09/29 17:07

A 回答 (6件)

No4です。


>補足ですが、この内容でコピーしたデータを値だけ貼り付けたいのですが、可能であればご教授ください。

値だけがコピーされるようになっています。
実際にこのマクロを動かして、ご確認ください。
そのうえであなたの希望に沿っていない場合は、「この内容でコピーしたデータを値だけ貼り付けたい」というのを、もっと具体的に提示していただけませんでしょうか。
この回答への補足あり
    • good
    • 0

A8からF最終行 とありますがA列のデータ数は担保できるのでしょうか?



代入式とコピーを混同している(読めない)ようですし・・・
>一部でも構いませんので例文など・・ 
スルーされたようなのでどうでも良いのですけれど・・
自身で解決したいのだと勘違いしました。。

Sub Test02()
Dim fld As String
Dim myWs As Worksheet
fld = ThisWorkbook.Path & "\"
Set myWs = ThisWorkbook.Worksheets("TEST")

Dim lastRow As Long
Dim ws As Worksheet
Dim f As String
Dim rng As Range

f = Dir(fld & "*.xls*")
Application.ScreenUpdating = False
myWs.Rows("12:" & myWs.Rows.Count).ClearContents
Do While f <> ""
'新規行を取得するコード
lastRow = Application.Max(12, myWs.Cells(myWs.Rows.Count, "F").End(xlUp).Row + 1)
If ThisWorkbook.Name <> f Then
With Workbooks.Open(fld & f)
On Error Resume Next
Set ws = .Worksheets("テストシート")
Set rng = ws.Range(ws.Cells(8, "A"), ws.Cells(ws.Rows.Count, "F").End(xlUp))
'rng.Copy myWs.Cells(lastRow, "A") '書式もコピーしたい場合
myWs.Cells(lastRow, "A").Resize(rng.Rows.Count, 6).Value = rng.Value
.Close SaveChanges:=False
End With
End If
f = Dir()
Loop
Application.ScreenUpdating = True
End Sub
環境(機種)依存文字★は排除しています
    • good
    • 0
この回答へのお礼

スルーしたつもりはなかったのですが、大変失礼致しました!

ご指摘の通り、コピーと代入の区別がしっかりできていないのが混乱の原因の一つだったように思います。
自分には分不相応なことをしようとしていたと理解しました。
書いていただいたもので考えていた動作が行われました。これをひとつひとつ読み理解して使えるよう勉強いたします!ありがとうございます。

お礼日時:2022/09/29 17:13

以下のマクロを標準モジュールに登録してください。


不明点があれば、補足してください。

Option Explicit
Public Sub データ集計()
Dim ms As Worksheet '★TESTシート
Dim fname As String '元データのファイル名
Dim wb As Workbook '元データのブック
Dim ws As Worksheet '元データのシート
Dim maxrow As Long 'テストシートの行数
Dim mrow As Long '★TESTシートの行番号
Dim row_count As Long '集計対象となる行数
Set ms = Worksheets("★TEST")
'12行以降をクリア
ms.Rows("12:" & Rows.Count).ClearContents
mrow = 12
fname = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While fname <> ""
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & fname)
Set ws = wb.Worksheets("テストシート")
maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
row_count = maxrow - 7
'8行目以降にデータがあるならコピーする
If row_count > 0 Then
ms.Cells(mrow, 1).Resize(row_count, 6).Value = ws.Cells(8, 1).Resize(row_count, 6).Value
mrow = mrow + row_count
End If
wb.Close SaveChanges:=False
fname = Dir()
Loop
MsgBox ("完了")
End Sub
この回答への補足あり
    • good
    • 0

こんばんは


スタートの行が12行目からで貼り付ける度に最後の行の1つ下の行から貼り付けるプロセスになると思います
ご質問にある範囲はA~F最終行)を貼り付けるので最大行の列はF列と推定できます従ってF列を対象に最終行を取得すれば良いことになります

この条件を満たす(行№を取得する)コードは色々書き方があります
IF文で取得した値が<=12なら12 違えば取得した値とか・・・
シート関数のMAXを使って最大値を取得するとかですね

すでにコードを書かれていて ご質問にある躓いている所を想像し例を挙げると次のようなコードになります

Sub Test01()
'12行より新規行に値を書き出す
Dim i As Integer
Dim lastRow As Long
For i = 1 To 10
'新規行を取得するコード
lastRow = WorksheetFunction.Max(12, Cells(Rows.Count, "F").End(xlUp).Row + 1)
'取得した変数lastRow の値を使ってセル範囲に値を代入するコード
Cells(lastRow, "A").Resize(2, 6) = "A" & i
Next
End Sub

Resize(2 なので2ずつ同じ値がA12~F列に代入(書き込み)され、
10回繰り返します(31行まで)
Cells(lastRow, "A").Resize(2, 6) = "A" & i を 単なるコピーの場合は
Destination側に指定します(Copyメソッドの説明は割愛)
・・.copy Cells(lastRow, "A") とすれば実行可能と思います

追記
ご質問の内容で、であろうプロシージャを書く事も出来そうですが
>作成中のvba がどのようなものか分かりませんし無駄にするべきでは無いかと、 出来上がったものを使うだけでは楽しくないと思いますので >・・・のに躓いています。
の部分を回答しました
フォルダ内すべてのファイルに対しての実行方法なども判らないと言う事であれば、切り分けてご質問されるのが良いと思います
    • good
    • 1

んー。


まず、「マクロの記録」で一通りの作業手順を記録させて、
そののちに、”ファイル名”,”シート名”,”セル番地”を直接指定している部分を希望する【繰り返し作業】に置き換える。

これで良いはずなんですが、この手の作業中の、どの部分を置き換えることができないのかを
明確に示していただけないでしょうか。

>全てのデータがからならないように表にして

何言ってるのか分からないんです。
「からならない」って方言でしょうか?
少なくとも名古屋人の自分には何を伝えようとしているのか分からないのです。
「かさならない」の誤入力で「データが重複しない」と言いたいのでしょうか?
(重複したデータは一番最後にまとめて削除すれば良い。そのほうが処理が早い)

・・・

なお、Excelなどのマクロは VBA(Visual Basic for Application) という
プログラム言語で書かれているものなんです。
ですので、フローチャートなど論理的な処理を行う手順を構築できなければ、
「マクロの記録」の垂れ流し処理で我慢するようにしましょう。
この回答への補足あり
    • good
    • 0

なんだかんだと言ってもさ、



マクロは中トロが一番だよ!
    • good
    • 3

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング