Question

在我的userform中我有一个组合框允许我从我的工作簿中存在的所有工作表中进行选择，我想要的是当我选择工作表时，如果可能的话，所有范围应该被复制到另一个工作表中可以帮助我，这里是我用于组合框的代码

Private Sub ComboBox1_Change()
Const ColItems  As Long = 20
Const LetterWidth As Long = 20
Const HeightRowz As Long = 18
Const SheetID As String = "__SheetSelection"

Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": i = 0

Application.ScreenUpdating = False

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(SheetID).Delete
Application.DisplayAlerts = True
Err.Clear

Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 78: TopPos = 40

For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
i = i + 1

If i Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 40
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If

intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16.5
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 13

End If
Next objSheet

If i > 0 Then

.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24

With .DialogFrame
.Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + (optMaxChars * LetterWidth) + 24
.Caption = "Select sheet to go to"
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
Application.ScreenUpdating = True

If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
Exit For
End If
Next objOpt
End If

If optCaption = "" Then
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
Exit Sub
Else

MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Activate

End If

End If

Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True

End With
End Sub

Answer 1

在搜索之后，解决方案非常简单我只需更改此行Sheets(optCaption).Activate 到

Sheets(optCaption).Range("A1:F10000").copy Destination:=Sheets("operations").Range("A1:F10000")

对于那些感兴趣的人

复制范围从组合框中的工作表选择到另一个工作表

1 个答案: