マクロが転置され、カラムの列を埋めるように変更する必要があります

Question

コピーするマクロを実行していて、次に使用可能な列を見つけて値としてペーストします。

私が気づいたことは、気にしていたことですが、データを1時間ごとに取り込むことで、縦に格納するのが簡単になりました。

以下のマクロは、次に使用可能な列を見つけて、その隣に貼り付けます。私はそれを変更しようとしました。たとえば、列Aの行の横にある日付とともに貼り付けを転記するようにしましたが、私はそれを解決するために苦労しています。

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

最後の部分にこれらの改訂が何をすべき

Sub HistoricalDataNewOne() 
Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceCol As Integer, SourceCells As Range 

'If an error occurs skip code to the Err-Hanlder line and the display the error message. 
On Error GoTo Err_Handler 

'This is the sheet where your copy information from. Change "Sheet1" to the name of your soure sheet 
Set SourceSht = ThisWorkbook.Sheets("BARGE LIVE TRACKING") 

'Name of the sheet where data is to be copied to. Rename Sheet2 to the name of your target sheet 
Set TargetSht = ThisWorkbook.Sheets("Detailed Tracking") 

'This is the cells you will copy data from. This is targeting cells B1 to the last used cell in column B 
Set SourceCells = SourceSht.Range("g3:h" & SourceSht.Range("J65536").End(xlUp).Row) 

'This is finding the next column available in the target sheet. It assumes dates will be in row 1 and data in row 2 down 
If TargetSht.Range("A1").Value = "" Then 
    'Cell A1 is blank so the column to put data in will be column #1 (ie A) 
    SourceCol = 1 
ElseIf TargetSht.Range("IV1").Value <> "" Then 
    'Cell IV1 has something in it so we have reached the maximum number of columns we can use in this sheet. 
    'Dont paste the data but advise' 
    MsgBox "There are no more columns available in the sheet " & TargetSht.Name, vbCritical, "No More Data Can Be Copied" 
    'stop the macro at this point 
    Exit Sub 
Else 
    'cell A1 does have data and we havent reached the last column yet so find the next available column 
    SourceCol = TargetSht.Range("IV1").End(xlToLeft).Column + 2 
End If 

'Put in the date in the appropriate column in row 1 of the target sheet 
TargetSht.Cells(1, SourceCol).Value = Format(Now, "HH:MM DD/MMM") 

'We can now start copying data. This will copy the cells in column B from the source sheet to row 2+ in the target sheet 
SourceCells.Copy 
TargetSht.Cells(2, SourceCol).PasteSpecial xlPasteValues 

Exit Sub 'This is to stop the procedure so we dont display the error message every time. 

Err_Handler: 
MsgBox "The following error occured:" & vbLf & "Error #: " & Err.Number & vbLf & "Description: " & Err.Description, _ 
     vbCritical, "An Error Has Occured", Err.HelpFile, Err.HelpContext 


End Sub 

Answer 1

：

Sub HistoricalDataNewOne() 
    Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceCells As Range 

    'If an error occurs skip code to the Err-Hanlder line and the display the error message. 
    On Error GoTo Err_Handler 

    'This is the sheet where your copy information from. Change "Sheet1" to the name of your soure sheet 
    Set SourceSht = ThisWorkbook.Sheets("BARGE LIVE TRACKING") 

    'Name of the sheet where data is to be copied to. Rename Sheet2 to the name of your target sheet 
    Set TargetSht = ThisWorkbook.Sheets("Detailed Tracking") 

    'This is the cells you will copy data from. This is targeting cells B1 to the last used cell in column B 
    Set SourceCells = SourceSht.Range("g3:h" & SourceSht.Range("J65536").End(xlUp).Row) 

    '''''''''''''''''''''''''''''' 
    ' No changes so far 
    ' Now the changes: 
    '''''''''''''''''''''''''''''' 
    Dim dstRow As Long: dstRow = TargetSht.Range("A1000000").End(xlUp).Row + 2 

    'Put in the date in the appropriate row columns A 1 of the target sheet 
    TargetSht.Cells(dstRow, 1).Value = Format(Now, "HH:MM DD/MMM") 
    TargetSht.Cells(dstRow, 2).Resize(SourceCells.Columns.Count, SourceCells.Rows.Count).Value2 = _ 
     Application.Transpose(SourceCells.Value2) 

    Exit Sub 'This is to stop the procedure so we dont display the error message every time. 

Err_Handler: 
    MsgBox "The following error occured:" & vbLf & "Error #: " & Err.Number & vbLf & "Description: " & Err.Description, _ 
      vbCritical, "An Error Has Occured", Err.HelpFile, Err.HelpContext 

End Sub