エクセルの複数の表を整理したいです。

エクセルで画像の左側のように会社ごとの表が縦に並んでいるものを、行の項目を列の項目にして連続して画像の右側のようにするにはどうしたらよいでしょうか。

全部で左側の形の表が5000個近くあるため、コピーして行列入れ替えて貼り付けだとどうしても時間がかかりすぎてしまいます。

質問が下手で申し訳ありませんが、よろしくお願いいたします。

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

• 企業の5年間の財務データを列に項目をとって並べる効率的な方法が知りたいです。
  a~eのところには、売上高や純利益などが入ります。
  画像を見てもらうのが一番わかりやすいと思いますが、左側のような表を右側のように並べたいです。

    補足日時：2018/01/22 18:42

• わかりにくいと思ったので改めて説明します。
  現在、企業の2007年から2011年の5年間の財務データの表が企業ごとにたくさんある状態です。
  それを行に年、列に財務データの項目をとって、一つの表にまとめたいと思っております。
  
  地道に行と列を入れ替えてコピペする方法だと、どうしても時間がかかるため、効率的な方法を教えていただきたいです。
  よろしくお願いいたします。

    補足日時：2018/01/22 19:15

No.3 ベストアンサー 回答者： tom04 回答日時： 2018/01/22 20:42

こんばんは！

＞全部で左側の形の表が5000個近くあるため・・・

というコトは約35000行データがあるというコトなのでしょうか。
VBAになりますが、一例です。
元データはSheet1にあり、Sheet2に表示するようにしてみました。
画像通りの配置になっているという前提です。

標準モジュールにしてください。

Sub Sample1()
Dim i As Long, j As Long, k As Long
Dim myArea As Range, wS As Worksheet
Dim myR1, myR2

Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
.Range("A2:A6").Copy
wS.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 7
Set myArea = wS.Cells(Rows.Count, "B").End(xlUp).Offset(1, -1).Resize(5, 6)
myR1 = .Cells(i, "B").Resize(6, 5)
myR2 = myArea
For k = 1 To UBound(myR1, 1)
For j = 1 To 5
myR2(j, k) = myR1(k, j)
Next j
Next k
myArea = myR2
Next i
End With
wS.Activate
MsgBox "完了"
End Sub

※　「応答なし」になると思いますが、じっと待っていてください。
約35000行のデータで20秒程度かかりました。m(_ _)m

この回答へのお礼

非常に丁寧にありがとうございました。
私は全くマクロの知識がないため、友人に見せ、非常に助かりました。
ありがとうございます。

お礼日時：2018/01/22 22:25

No.2 回答者： mike_g 回答日時： 2018/01/22 20:19

Sheet2!B2: =OFFSET(Sheet1!$A$1,FLOOR((ROW(A1)-1)/5,1)*7+1+COLUMN(A1)-1,MOD(ROW(A1)-1,5)+1)

【為念】補足は一切読んでいません。

この回答へのお礼

回答ありがとうございました。
参考にさせていただきました。本当にありがとうございます。

お礼日時：2018/01/22 22:26

No.1 回答者： LHS07 回答日時： 2018/01/22 18:23

説明が下手でよく解りません。

ちゃんと説明してください。