复制并粘贴到另一张图纸Excel vba中的新列

我在表1中有数据，时间在A列和当前B列。多次运行的数据都在一列中，因此我想将每次运行分离到一个新列中

测量长度可变，因此我希望excel在A列中找到0值，并在b列中复制相应的值，直到在A列中找到新的0值，并将其复制到表2中的新列

到目前为止，excel将成功地找到b列中的数据，并将其复制到sheet2，但它通过重复复制粘贴将该数据填充到整个列中，直到我复制数据到的所有列都已填充，第一列和最后一列除外。我怎样才能解决这个问题？以下是我到目前为止的情况：

    Sub CopyValuestoSheet2()
Dim strsearch As String
Dim lastline As Integer
Dim tocopy As Integer
Dim StartValue As Integer
Dim FinishValue As Integer
Dim Col2 As Integer
Dim TempValue As Integer
Dim EndValue As Integer

strsearch = CStr(InputBox("enter time to search for (usually 0)"))
lastline = Range("A65536").End(xlUp).Row
Col2 = 1
TempValue = 1

For i = 2 To lastline
    'This part selects the data in column B based off of finding the value in column A
    For Each c In Range("A" & i & ":A" & i)
        If InStr(c.Text, strsearch) Then
            tocopy = 1
            StartValue = TempValue
            FinishValue = i
            TempValue = FinishValue
            FinishValue = FinishValue - 1
        End If
    Next c
'Here is where I actually copy the data over
 If tocopy = 1 Then
        'I want to copy the range row StartValue to row FinishValue in column B
        Range("B" & StartValue & ":B" & FinishValue).Copy
    'I want to paste it to a new column each time
        Paste Destination:=Sheets(2).Columns(Col2)
        Col2 = Col2 + 1
        Sheets("Sheet1").Select
    End If
tocopy = 0
Next i
    'Printing the last data point since there is no 0 after the final entry.
    'This part works fine even though it is just a copy-paste of the If statement
        FinishValue = FinishValue + 1
        'This will fail if the last datapoint has more thatn 500 enteries
        EndValue = FinishValue + 500
        Range("B" & FinishValue & ":B" & EndValue).Copy
        Sheets("Sheet2").Select
        Paste Destination:=Sheets(2).Columns(Col2)
        Sheets("Sheet2").Select

End Sub

---

这应该更好：

Sub CopyValuestoSheet2()
    Dim strsearch As String
    Dim lastline As Integer
    Dim tocopy As Integer
    Dim StartValue As Integer
    Dim FinishValue As Integer
    Dim Col2 As Integer
    Dim TempValue As Integer
    Dim EndValue As Integer

strsearch = CStr(InputBox("enter time to search for (usually 0)"))
lastline = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Col2 = 1
TempValue = 1

For I = 2 To lastline
    'This part selects the data in column B based off of finding the value in column A
    For Each c In Range("A" & I & ":A" & I)
        If InStr(c.Text, strsearch) Then
            tocopy = 1
            StartValue = TempValue
            FinishValue = I
            TempValue = FinishValue
            FinishValue = FinishValue - 1
        End If
    Next c
'Here is where I actually copy the data over
 If tocopy = 1 Then
        'I want to copy the range row StartValue to row FinishValue in column B
        Range("B" & StartValue & ":B" & FinishValue).Copy
    'I want to paste it to a new column each time
        Paste Destination:=Sheets(2).Range(ColLet(Col2) & "$1:$" & ColLet(Col2) & (FinishValue - StartValue + 1))
        Col2 = Col2 + 1
        Sheets("Sheet1").Select
    End If
tocopy = 0
Next I
    'Printing the last data point since there is no 0 after the final entry.
    'This part works fine even though it is just a copy-paste of the If statement
        FinishValue = FinishValue + 1
        'This will fail if the last datapoint has more thatn 500 enteries
        EndValue = Range("B" & FinishValue).End(xlDown).Row
        Range(Range("B" & FinishValue), Range("B" & EndValue)).Copy

        Paste Destination:=Sheets(2).Range(ColLet(Col2) & "$1:$" & ColLet(Col2) & (EndValue - FinishValue + 1))


End Sub

请注意，.select是一个非常贪婪的资源，并且通常是无用的命令，所以请尽量避免它

Public Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
    ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function

---

您正在检查列A值是否包含strSearch，而不是列A值是否完全是strSearch。假设strSearch=0，是否可能因为A值包含0而拾取非0？需要查看一些示例数据。我如何指定只拾取精确的0，而不只是包含0的数字？我刚刚测试了它，这也是一个问题。夹头功能是如何工作的？当我尝试这个解决方案时，我得到了一个编译错误，表示子函数或函数没有定义，并且ColLet的第一个实例被突出显示。我尝试将其定义为字符串、整数、长字符和范围，但这似乎没有任何帮助。