Question

我正在运行一个复制的宏，找到下一个可用的列，然后粘贴为值。

在不情愿地继续在专栏中进行之后，我意识到将它垂直存储起来更容易 - 每小时都会提取数据，因此在列中进行总结需要花费很多精力。

下面的宏找到下一个可用列，然后在它旁边粘贴。我试图更改它，以便它会将日期旁边的粘贴转置到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

需要更改一个宏，以便它转换和填充行的instread

1 个答案: