VBAを使用してシート1からシート2にデータを回す

Question

私は私の問題の答えを見つけるためにインターネットを見回しました。 Excelのシート1からシート2にデータをコピーする必要がありますが、行は列に変換する必要があります。

sheet1では、タイトル、スコープ、および期限が列Aに、列Bにはこれらの見出しに提供されています。 シート2では、CommandButtonをクリックして、それぞれA1、B1、C1のタイトル、スコープ、デッドライン、およびこれらの見出しの下のデータを表示します。これを行うと、コードはsheet2のタイトルをリストするときにsheet1のすべての4行目を選択する必要があります。

少し試してみましたが、できません。私の考えは、何らかのループを使用することです。

Destination Sheet2

Source sheet1

Private sub CommandButton1_Click() 
    shSource=WorkSheets("Sheet1") 
    shDest=WorkSheets("Sheet2") 
    LastRow = shSource.Range("A" & Rows.Count).End(xlUp).Row 
    For i = 1 To LastRow 
     Range("A1").Offset(4, 0).Select 
     Selection.Copy 
     shDest.Select 
     shDest.Range("A1").Select 
     If shDest.Range("A1").Offset(1, 0) <> "" Then 
      shDest.Range("A1").End(xlDown).Select 
     End If 
     ActiveCell.Offset(1, 0).Select 
     ActiveCell.Paste 
    Next i 
End Sub 

は、私は本当にあなたのいくつかは私を助けることができると思います。 おかげで、 ミシェル

Answer 1

あなたはこのような何か試すことができます：それはtransponse機能の代用である

Sub moveData() 

    Set sourceSheet = Worksheets("Sheet1") 
    Set targetSheet = Worksheets("Sheet2") 

    lastRow = sourceSheet.Cells(1, 1).End(xlDown).Row ' assume your data starts are A1 cell 
    lastColumn = sourceSheet.Cells(1, 1).End(xlToRight).Column 

    For columnCounter = 1 To lastColumn 
     For rowCounter = 1 To lastRow 
      targetSheet.Cells(columnCounter, rowCounter) = sourceSheet.Cells(rowCounter, columnCounter) 
     Next 
    Next 

End Sub 

は、あなたがあなたのニーズに合わせてそれを変更することができます願っています。

Answer 2

ない完璧なしかし、動作するはずです -

Sub test() 

    Dim rngSource As Range 
    Dim rngTarget As Range 

    Set rngSource = Sheets("Sheet1").Range("B2") 
    Set rngTarget = Sheets("Sheet2").Range("A2") 

    Dim strArr() As String 
    ReDim strArr(0 To 4, 0 To 0) 
    Dim i As Integer 
    i = 0 
    Do While rngSource.Value <> "" 
     With rngSource 
      strArr(0, i) = .Offset(0, 0).Value 
      strArr(1, i) = .Offset(1, 0).Value 
      strArr(2, i) = .Offset(2, 0).Value 
      strArr(3, i) = .Offset(0, 1).Value 
      strArr(4, i) = .Offset(0, 2).Value 
     End With 
     i = i + 1 
     Set rngSource = rngSource.Offset(4, 0) 
     ReDim Preserve strArr(4, i) 

    Loop 

    Range(rngTarget, rngTarget.Offset(i, 4)).Value = _ 
      Application.WorksheetFunction.Transpose(strArr) 

End Sub