![](/img/trans.png)
[英]VBA Copy values without formulas, then paste to another excel sheet and continue to add values to new sheet
[英]Copy and paste to new column in another sheet 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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.