2016-04-21 88 views
0

在我的用戶表單中,我有一個組合框,允許從工作簿中存在的所有工作表中進行選擇,我想要的是在選擇工作表時,所有範圍應被複制到另一個工作表,如果有可能可以幫助我在這裏爲我尋找後,使用該組合框從組合框中的工作表中選擇複製範圍到另一個工作表

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 
+0

什麼_「所有範圍」_是?另一個sheet_應該如何選擇/識別? – user3598756

+0

範圍冷藏箱到列我有5列從A到F,並從所有現有牀單在組合框中選擇我只需點擊組合框,然後我有一個其他msgbox,允許我從現有牀單中選擇我將下載Excel文件供您查看 – mateos

回答

0

很好的代碼,該解決方案是如此簡單,我需要的只是改變這一行Sheets(optCaption).Activate

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

對於那些有興趣的人

相關問題