| 
    
     |  | Sheet1のデータを、二次元配列に取り込みそれをSheet5のシートの列 に代入したいのですが、やり方がわからずこまっています。
 わかる方いらしたら教えてくださいよろしくお願いします。
 
 Shhet1内容
 B2からF22まで題目がありますG2〜2最終列まで日にち B3からF51まで製品内容
 C3からFE51まで予定数のクロス集計表
 
 Sheet5
 Sheet1の内容をデータベースシートにしたいです。
 
 途中までのプログラム
 
 Option Base 1
 
 Sub テーブルに変換()
 
 
 Dim Myval2() '配列Myval2宣言
 Dim Myval
 Dim tmp
 
 
 Dim i As Long 'Long型 iを宣言
 Dim K As Long 'Long型 Kを宣言
 Dim m As Long
 Dim s As Long
 Dim Sh1 As Worksheet
 Dim Sh5 As Worksheet
 
 Dim Myval3()
 
 Set Sh1 = Worksheets("Sheet1")
 Set Sh5 = Worksheets("Sheet5")
 
 Sh1.Activate
 Range("A1").Select
 
 
 Myval = Sh1.Range("B2").Resize _
 (Range("B65536").End(xlUp).Row, Range("xfc2").End(xlToLeft).Column)
 
 ReDim Preserve Myval2(UBound(Myval, 1), UBound(Myval, 2))
 
 
 For i = 1 To UBound(Myval, 1)
 
 For K = 6 To UBound(Myval, 2)
 
 
 Myval2(i, K) = Myval(i, 1) & "_" & Myval(i, 2) & "_" & Myval(i, 3) _
 & "_" & Myval(i, 4) & "_" & Myval(i, 5) _
 & "_" & Myval(1, K) & "_" & Myval(i, K)
 
 
 Next
 Next
 
 
 Sh5.Activate
 Sh5.Cells(1, 1).Select
 
 ’ここでSheet5へ転記したいのですが、やり方がわかりません
 
 
 Columns("A:A").Select
 Selection.AutoFilter
 ActiveSheet.Range("$A$1:$A$10000").AutoFilter Field:=1, Criteria1:="<>"
 Selection.Copy
 Columns("B:B").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
 Columns("A:A").Select
 Selection.Delete Shift:=xlToLeft
 
 
 For m = 2 To Range("A65536").End(xlUp).Row
 
 
 tmp = Split(Cells(m, 1), "_")
 Cells(m, 2) = tmp(0)
 Cells(m, 3) = tmp(1)
 Cells(m, 4) = tmp(2)
 Cells(m, 5) = tmp(3)
 Cells(m, 6) = tmp(4)
 Cells(m, 7) = tmp(5)
 Cells(m, 8) = tmp(6)
 Next
 
 
 Range("A:A").Select
 
 Selection.Delete
 
 
 End Sub
 
 
 |  |