ここから本文です

エクセル、マクロ、VBAの質問です。

chi********さん

2018/9/2517:24:30

エクセル、マクロ、VBAの質問です。

下記にするにはどういうコードを組めばよいのでしょうか?

フォルダの中の複数のブック(100個くらいあります。ブック名はばらばらです。)の「製作図」というシートのセルを現在開いてる白紙のブックのセルに反映させたいのです。

反映させたい各ブックのセルは以下の通りです。

B1〜B36までを白紙のブックのA2〜AJ2へ(横に並べたいです。)
F1〜F18までをAK2〜BB2まで。

上記横並びの情報をブック毎に縦に並べるイメージです。


宜しくお願い致します。

閲覧数:
60
回答数:
2
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

kik********さん

2018/9/2517:50:10

過去に回答した以下、応用できませんか?

エクセルマクロVBAに関しての質問です。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q131935581...

動かなかった?・・・使えなかった?・・・ということ?

B1:F36 を読み込んで
B1:B36 を 1:36 行目に、F1:F18 を 41:58 行目に・・・・
作業用シートに横に並べ終わったら、
其々の範囲を、行列変換したものを空白のブックに設定すれば・・・・

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

hot********さん

2018/9/2520:05:30

こんなでしょうか。

Sub sample()
Dim folder As String
Dim ds As Worksheet
Dim file As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Long
'
folder = "C:\sample\" '対象フォルダ
Set ds = ActiveSheet '結果シート
r = 2 '結果表示行の初期値=2
file = Dir(folder & "*.xlsx") 'フォルダ内の最初のxlsxファイル名
Do While file <> "" 'ファイル名がある間
Application.ScreenUpdating = False '画面更新禁止(ちらつき防止)
Set wb = Workbooks.Open(folder & file) 'Bookを開く
Set ws = Nothing '製作図シートが無かった場合に備える
On Error Resume Next 'エラートラップ開始
Set ws = wb.Sheets("製作図") '製作図シート取得(無い場合はNothing)
On Error GoTo 0 'エラートラップ終了
If Not ws Is Nothing Then '製作図シートがあったら
ws.Range("B1:B36").Copy 'B1:B36コピー
ds.Range("A" & r).PasteSpecial Transpose:=True 'A列結果表示行から縦横を入れ替えてペースト
ws.Range("F1:F18").Copy 'F1:F18コピー
ds.Range("AK" & r).PasteSpecial Transpose:=True 'AK列結果表示行から縦横を入れ替えてペースト
r = r + 1 '結果表示行+1
End If
wb.Close False 'Bookを保存せずに閉じる
Application.ScreenUpdating = True '画面更新許可
file = Dir '次のファイル名
Loop
End Sub

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる