搜索工作表并在工作表上粘贴结果（如果找到）

Question

Desired results 2所以基本上我在这里计算一个温度范围，然后在所有工作表中搜索这些范围副本并将它们粘贴到选定的工作表上。我遇到的困难是不得不将每张纸上的结果分开，因为回来了。

Dim ws As Worksheet
Dim tempint As Integer
Dim tempend As Integer
Dim tempstep As Integer
Dim k As Integer
Dim nt As Integer
Dim xtemp As Integer
Dim finalrow As Integer
Dim i As Integer


tempint = ComboBox_TempInt.Value
tempend = ComboBox_TempEnd.Value
tempstep = ComboBox_TempStep.Value


Userform1.Range("A2:c1000").ClearContents' to clear sheet where  results are pasted 

For Each ws In Sheets
     ws.Select

       nt = (tempend - tempint) / tempstep 'to get number of results 
         For k = 1 To (nt + 1)
          xtemp = tempint + (k - 1) * tempstep


    finalrow = Cells(Rows.Count, 1).End(xlUp).Row

       For i = 2 To finalrow
     If ws.Cells(i, 1).Value = xtemp Then
     Range(Cells(i, 1), Cells(i, 8)).Copy
     Userform1.Select

      Range("A500").End(xlUp).Offset(1, 0).PasteSpecial 
  xlPasteFormulasAndNumberFormats
     ws.Select
     End If
    Next i
   Next k

 Next ws

结果只是相互回归，希望工作表名称能够分隔每个结果

Answer 1

试试这个。我删除了Select，否则只为工作表名称添加了一行。你不应该在开始时清除比A-C更多的列吗？一种更有效的方法是AutoFilter或Find，它可以避免遍历每一行。

Sub x()

Dim ws As Worksheet
Dim tempint As Long
Dim tempend As Long
Dim tempstep As Long
Dim k As Long
Dim nt As Long
Dim xtemp As Long
Dim finalrow As Long
Dim i As Long

tempint = ComboBox_TempInt.Value
tempend = ComboBox_TempEnd.Value
tempstep = ComboBox_TempStep.Value

Userform1.Range("A2:c1000").ClearContents ' to clear sheet where  results are pasted

For Each ws In Sheets
    With ws
        userform1.Range("A" & Rows.Count).End(xlUp)(2).Value = .Name
        nt = (tempend - tempint) / tempstep 'to get number of results
        For k = 1 To (nt + 1)
            xtemp = tempint + (k - 1) * tempstep
            finalrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            For i = 2 To finalrow
                If .Cells(i, 1).Value = xtemp Then
                    .Range(.Cells(i, 1), .Cells(i, 8)).Copy
                    Userform1.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
                End If
            Next i
        Next k
    End With
Next ws

End Sub

Answer 2

Final result

这是我必须解决的代码。

Private Sub Cmd_Button_Click()
Dim ws As Worksheet
Dim tempint As Long
Dim tempend As Long
Dim tempstep As Long
Dim k As Integer
Dim nt As Integer
Dim xtemp As Long
Dim finalrow As Integer
Dim i As Integer


  tempint = ComboBox_TempInt.Value
  tempend = ComboBox_TempEnd.Value
   tempstep = ComboBox_TempStep.Value


   Userform1.Range("A2:H1000").ClearContents

      For Each ws In Sheets
       ws.Select
    Userform1.Range("A" & Rows.Count).End(xlUp)(2).Value = ws.Name
  nt = (tempend - tempint) / tempstep
   For k = 1 To (nt + 1)
    xtemp = tempint + (k - 1) * tempstep


finalrow = Cells(Rows.Count, 1).End(xlUp).Row

 For i = 2 To finalrow
     If Cells(i, 1).Value = xtemp Then

     Range(Cells(i, 1), Cells(i, 8)).Copy

     Userform1.Range("A500").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

     End If
   Next i
Next k


 Next ws
 Unload UserForm_propeties
 Userform1.Select
End Sub