Вставьте поля ввода, чтобы сделать код более интерактивным

Вы можете установить пользовательскую форму в качестве входных данных в программу - что-то вроде того, что следует. Вам нужно только один раз запустить подпрограмму CreateUserForm, чтобы настроить обработчики событий UserForm1 в вашей электронной таблице. Как только это будет сделано, вы можете запустить «Тест», чтобы увидеть саму форму UserForm1. Вы можете отредактировать обработчики событий, чтобы проверить ввод пользователя или отклонить его, если это необходимо. Также после настройки UserForm1 вы можете перемещать различные метки и списки и, конечно же, создавать новые. Это должно выглядеть так:

Вы можете выбрать столько листов, сколько требуется, из последнего списка, и выбор будет добавлен в коллекцию vba. Посмотрите MsgBox в начале вашего кода и поиграйте с вводом значений/выборов в поле пользователя, чтобы увидеть, что он делает.

Обработчик UserForm, который вызывается при нажатии кнопки «ОК», сохранит выбор в глобальные переменные, чтобы их можно было использовать в коде.

Option Explicit

' Global Variables used by UserForm1
Public lst1BoxData As Variant
Public threshold As Integer
Public currencyCol As String
Public selectedSheets As Collection

' Only need to run this once.  It will create UserForm1.
' If run again it will needlessly create another user form that you don't need.
' Once it's run you can modify the event handlers by selecting the UserForm1
' object in the VBAProject Menu by right clicking on it and selecting 'View Code'

' Note that you can select multiple Sheets on the last listbox of the UserForm
' simply by holding down the shift key.
Sub CreateUserForm()
  Dim myForm As Object
  Dim X As Integer
  Dim Line As Integer

  'This is to stop screen flashing while creating form
  Application.VBE.MainWindow.Visible = False

  Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)

  'Create the User Form
  With myForm
   .Properties("Caption") = "Currency Settings"
   .Properties("Width") = 322
   .Properties("Height") = 110
  End With

  ' Create Label for threshold text box
   Dim thresholdLabel As Object
   Set thresholdLabel = myForm.Designer.Controls.Add("Forms.Label.1")
   With thresholdLabel
     .Name = "lbl1"
     .Caption = "Input Threshold:"
     .Top = 6
     .Left = 6
     .Width = 72
   End With

  'Create TextBox for the threshold value
  Dim thresholdTextBox As Object
  Set thresholdTextBox = myForm.Designer.Controls.Add("Forms.textbox.1")
  With thresholdTextBox
    .Name = "txt1"
    .Top = 18
    .Left = 6
    .Width = 75
    .Height = 16
    .Font.Size = 8
    .Font.Name = "Tahoma"
    .borderStyle = fmBorderStyleSingle
    .SpecialEffect = fmSpecialEffectSunken
  End With

  ' Create Label for threshold text box
   Dim currencyLabel As Object
   Set currencyLabel = myForm.Designer.Controls.Add("Forms.Label.1")
   With currencyLabel
     .Name = "lbl2"
     .Caption = "Currency Column:"
     .Top = 6
     .Left = 100
     .Width = 72
   End With

  'Create currency column ListBox
  Dim currencyListBox As Object
  Set currencyListBox = myForm.Designer.Controls.Add("Forms.listbox.1")
  With currencyListBox
    .Name = "lst1"
    .Top = 18
    .Left = 102
    .Width = 52
    .Height = 55
    .Font.Size = 8
    .Font.Name = "Tahoma"
    .borderStyle = fmBorderStyleSingle
    .SpecialEffect = fmSpecialEffectSunken
  End With

  ' Create Label for sheet text box
  Dim sheetLabel As Object
  Set sheetLabel = myForm.Designer.Controls.Add("Forms.Label.1")
  With sheetLabel
    .Name = "lbl3"
    .Caption = "Select Sheets:"
    .Top = 6
    .Left = 175
    .Width = 72
  End With

  'Create currency column ListBox
  Dim sheetListBox As Object
  Set sheetListBox = myForm.Designer.Controls.Add("Forms.listbox.1")
  With sheetListBox
    .Name = "lst3"
    .Top = 18
    .Left = 175
    .Width = 52
    .Height = 55
    .Font.Size = 8
    .MultiSelect = 1
    .Font.Name = "Tahoma"
    .borderStyle = fmBorderStyleSingle
    .SpecialEffect = fmSpecialEffectSunken
  End With

  'Create Select Button
  Dim selectButton As Object
  Set selectButton = myForm.Designer.Controls.Add("Forms.commandbutton.1")
  With selectButton
    .Name = "cmd1"
    .Caption = "Okay"
    .Accelerator = "M"
    .Top = 30
    .Left = 252
    .Width = 53
    .Height = 20
    .Font.Size = 8
    .Font.Name = "Tahoma"
    .BackStyle = fmBackStyleOpaque
  End With

  ' This will create the initialization sub and the click event
  ' handler to write the UserForm selections into the global
  ' variables so they can be used by the code.
  myForm.CodeModule.InsertLines 1, "Private Sub UserForm_Initialize()"
  myForm.CodeModule.InsertLines 2, "   me.lst1.addItem ""Column I"" "
  myForm.CodeModule.InsertLines 3, "   me.lst1.addItem ""Column J"" "
  myForm.CodeModule.InsertLines 4, "   me.lst1.addItem ""Column M"" "
  myForm.CodeModule.InsertLines 5, "   me.lst3.addItem ""Sheet X"" "
  myForm.CodeModule.InsertLines 6, "   me.lst3.addItem ""Sheet Y"" "
  myForm.CodeModule.InsertLines 7, "   lst1BoxData = Array(""I"", ""J"", ""M"")"
  myForm.CodeModule.InsertLines 8, "End Sub"

  'add code for Command Button
  myForm.CodeModule.InsertLines 9, "Private Sub cmd1_Click()"
  myForm.CodeModule.InsertLines 10, "  threshold = CInt(Me.txt1.Value)"
  myForm.CodeModule.InsertLines 11, "  currencyCol = lst1BoxData(Me.lst1.ListIndex)"
  myForm.CodeModule.InsertLines 12, "  Set selectedSheets = New Collection"
  myForm.CodeModule.InsertLines 13, "  For i = 0 To Me.lst3.ListCount - 1"
  myForm.CodeModule.InsertLines 14, "    If Me.lst3.Selected(i) = True Then"
  myForm.CodeModule.InsertLines 15, "      selectedSheets.Add Me.lst3.List(i)"
  myForm.CodeModule.InsertLines 16, "    End If"
  myForm.CodeModule.InsertLines 17, "  Next"
  myForm.CodeModule.InsertLines 18, "  Unload Me"
  myForm.CodeModule.InsertLines 19, "End Sub"

  'Add form to make it available
  VBA.UserForms.Add (myForm.Name)

End Sub

' This is your code verbatim except for now
' the UserForm is shown for selecting the
' 1) currency threshold, 2) the column letter
' and 3) the sheets you want to process.
' The MsgBox just shows you what you've
' selected just to demonstrate that it works.

Sub Test()

Dim WS As Worksheet
Set WS = Sheets.Add
WS.Name = "Summary"

Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet
With Sheets("Summary")
  .Cells.Clear 
End With

'**** Start: Running & Checking UserForm Output ****
UserForm1.Show

Dim colItem As Variant
Dim colItems As String
For Each colItem In selectedSheets:
 colItems = colItems & " " & colItem
Next
MsgBox ("threshold=" & threshold & vbCrLf & _
        "currencyCol=" & currencyCol & vbCrLf & _
        "selectedSheets=" & colItems)
'**** End: Running & Checking UserForm Output ****

j = 2

For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> "Summary" Then
        lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).row
        For i = 4 To lastRow
            If sh.Range("J" & i) > 1000000 Or sh.Range("J" & i) < -1000000 Then
                sh.Range("a" & i & ":n" & i).Copy Destination:=Worksheets("Summary").Range("A" & j)
                Sheets("Summary").Range("N" & j) = sh.Name
                j = j + 1
            End If
        Next i
    End If
Next sh
Sheets("Summary").Columns("A:N").AutoFit
End Sub

Вы можете попробовать это

Option Explicit

Sub Test()
    Dim WS As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim sh As Worksheet
    Dim sheetsList As Variant
    Dim threshold As Long

    Set WS = GetSheet("Summary", True)
    sheetsList = Array("STRG","sheetx","sheety") '<--| fill this array with the sheets names to be looped through

    threshold = Application.InputBox("Input threshold", Type:=1)
    j = 2
    For Each sh In ActiveWorkbook.Sheets(sheetsList)
        lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
        For i = 4 To lastRow
            If sh.Range("J" & i) > threshold Or sh.Range("J" & i) < -threshold Then
                sh.Range("a" & i & ":n" & i).Copy Destination:=WS.Range("A" & j)
                WS.Range("N" & j) = sh.Name
                j = j + 1
            End If
        Next i
    Next sh
    WS.Columns("A:N").AutoFit
End Sub

Function GetSheet(shtName As String, Optional clearIt As Boolean = False) As Worksheet
    On Error Resume Next
    Set GetSheet = Worksheets(shtName)
    If GetSheet Is Nothing Then
        Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.count))
        GetSheet.Name = shtName
    End If
    If clearIt Then GetSheet.UsedRange.Clear
End Function

Следующий код работает для моих целей, за исключением выбора отдельных вкладок для цикла:

Option Explicit

Sub Test()
    Dim column As String
    Dim WS As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim sh As Worksheet
    Dim sheetsList As Variant
    Dim threshold As Long

    Set WS = GetSheet("Summary", True)

    threshold = Application.InputBox("Input threshold", Type:=1)
    column = Application.InputBox("Currency Column", Type:=2)
    j = 2
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> "Summary" Then
            lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
            For i = 4 To lastRow
                If sh.Range(column & i) > threshold Or sh.Range(column & i) < -threshold Then
                    sh.Range("a" & i & ":n" & i).Copy Destination:=WS.Range("A" & j)
                    WS.Range("N" & j) = sh.Name
                    j = j + 1
                End If
            Next i
        End If
    Next sh
    WS.Columns("A:N").AutoFit
End Sub

Function GetSheet(shtName As String, Optional clearIt As Boolean = False) As Worksheet
    On Error Resume Next
    Set GetSheet = Worksheets(shtName)
    If GetSheet Is Nothing Then
        Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
        GetSheet.Name = shtName
    End If
    If clearIt Then GetSheet.UsedRange.Clear
End Function