将数据复制到工作表 – 对象variables或未设置块variables
我试图将数据从一个工作表复制到另一个问题。
我有从我的工作表标题列表的combobox。 然后，我使用表格标题s根据combobox值确定将哪些列复制到新工作表。 它编辑表单，但一旦我保存，closures，并打开它抱怨“对象variables或块variables未设置”
Public Sub ExportButton_Click() If FileNameTxt.Value = "" Then MsgBox "Please choose a file name" WinOSBtn.Value = False ExportButton.Locked = True ExportButton.BackColor = RGB(250, 250, 250) ExportButton.ForeColor = RGB(220, 220, 220) FileNameTxt.SetFocus Else ExportButton.Locked = False ExportButton.BackColor = RGB(241, 241, 241) ExportButton.ForeColor = RGB(0, 0, 0) End If Dim historyWks As Worksheet Dim newWB As Workbook Set historyWks = Worksheets("NameList") 'Create ranges for each ComboBox Dim CBA As Range Set CBA = Range("A1:AM1").Find(ComboBoxA.Value) Dim CBB As Range Set CBB = Range("A1:AM1").Find(ComboBoxB.Value) Dim CBC As Range Set CBC = Range("A1:AM1").Find(ComboBoxC.Value) Dim CBD As Range Set CBD = Range("A1:AM1").Find(ComboBoxD.Value) Dim CBE As Range Set CBE = Range("A1:AM1").Find(ComboBoxE.Value) Dim CBF As Range Set CBF = Range("A1:AM1").Find(ComboBoxF.Value) Dim CBG As Range Set CBG = Range("A1:AM1").Find(ComboBoxG.Value) Dim CBH As Range Set CBH = Range("A1:AM1").Find(ComboBoxH.Value) Dim CBI As Range Set CBI = Range("A1:AM1").Find(ComboBoxI.Value) Dim CBJ As Range Set CBJ = Range("A1:AM1").Find(ComboBoxJ.Value) Dim CBK As Range Set CBK = Range("A1:AM1").Find(ComboBoxK.Value) Dim CBL As Range Set CBL = Range("A1:AM1").Find(ComboBoxL.Value) Dim CBM As Range Set CBM = Range("A1:AM1").Find(ComboBoxM.Value) Dim CBN As Range Set CBN = Range("A1:AM1").Find(ComboBoxN.Value) Dim CBO As Range Set CBO = Range("A1:AM1").Find(ComboBoxO.Value) Dim CBP As Range Set CBP = Range("A1:AM1").Find(ComboBoxP.Value) Dim CBQ As Range Set CBQ = Range("A1:AM1").Find(ComboBoxQ.Value) Dim CBR As Range Set CBR = Range("A1:AM1").Find(ComboBoxR.Value) Dim CBS As Range Set CBS = Range("A1:AM1").Find(ComboBoxS.Value) Dim CBT As Range Set CBT = Range("A1:AM1").Find(ComboBoxT.Value) Dim CBU As Range Set CBU = Range("A1:AM1").Find(ComboBoxU.Value) 'Prompts for a file name If FileNameTxt.Value = "" Then MsgBox "Please choose a file name" Else 'Add a new workbook with a file name Workbooks.Add ActiveWorkbook.SaveAs Filename:=FileNameTxt.Value & ".xls" 'ActiveWorkbook.Close Workbooks.Open (FileNameTxt.Value & ".xls") Set newWB = Workbooks(FileNameTxt.Value & ".xls") historyWks.Activate With historyWks If ComboBoxA <> "" Then Range(CBA, CBA.End(xlDown)).Copy '***The error starts here and indecates that CBA=Nothing 'CBA.End(xlDown)=Object variable* or With block variable not set newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues End If If ComboBoxB <> "" Then Range(CBB, CBB.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("B1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("B1").PasteSpecial xlPasteValues End If If ComboBoxC <> "" Then Range(CBC, CBC.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("C1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("C1").PasteSpecial xlPasteValues End If If ComboBoxD <> "" Then Range(CBD, CBD.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("D1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("D1").PasteSpecial xlPasteValues End If If ComboBoxE <> "" Then Range(CBE, CBE.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("E1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("E1").PasteSpecial xlPasteValues End If If ComboBoxF <> "" Then Range(CBF, CBF.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("F1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("F1").PasteSpecial xlPasteValues End If If ComboBoxG <> "" Then Range(CBG, CBG.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("G1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("G1").PasteSpecial xlPasteValues End If If ComboBoxH <> "" Then Range(CBH, CBH.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("H1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("H1").PasteSpecial xlPasteValues End If If ComboBoxI <> "" Then Range(CBI, CBI.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("I1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("I1").PasteSpecial xlPasteValues End If If ComboBoxJ <> "" Then Range(CBJ, CBJ.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("J1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("J1").PasteSpecial xlPasteValues End If If ComboBoxK <> "" Then Range(CBK, CBK.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("K1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("K1").PasteSpecial xlPasteValues End If If ComboBoxL <> "" Then Range(CBL, CBL.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("L1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("L1").PasteSpecial xlPasteValues End If If ComboBoxM <> "" Then Range(CBM, CBM.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("M1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("M1").PasteSpecial xlPasteValues End If If ComboBoxN <> "" Then Range(CBN, CBN.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("N1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("N1").PasteSpecial xlPasteValues End If If ComboBoxO <> "" Then Range(CBO, CBO.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("O1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("O1").PasteSpecial xlPasteValues End If If ComboBoxP <> "" Then Range(CBP, CBP.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("P1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("P1").PasteSpecial xlPasteValues End If If ComboBoxQ <> "" Then Range(CBQ, CBQ.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("Q1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("Q1").PasteSpecial xlPasteValues End If If ComboBoxR <> "" Then Range(CBR, CBR.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("R1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("R1").PasteSpecial xlPasteValues End If If ComboBoxS <> "" Then Range(CBS, CBS.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("S1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("S1").PasteSpecial xlPasteValues End If If ComboBoxT <> "" Then Range(CBT, CBT.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("T1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("T1").PasteSpecial xlPasteValues End If If ComboBoxU <> "" Then Range(CBU, CBU.End(xlDown)).Copy newWB.Sheets("Sheet1").Range("U1").PasteSpecial xlPasteAll newWB.Sheets("Sheet1").Range("U1").PasteSpecial xlPasteValues End If End With End If ExportForm.Hide Dim i As Long i = MsgBox("Export another?", vbOKCancel) If i = vbOK Then ExportForm.Show If i = vbCancel Then Unload ExportForm End If End Sub 我一直在search论坛，但我还在挣扎。 我相信有一个更聪明的方法来做到这一点，但我会到达那里。 得到错误的任何帮助将是非常好的！
稍微重构你的代码可以更短（也更强大）
Public Sub ExportButton_Click() Dim historyWks As Worksheet Dim newWB As Workbook, newSht As Worksheet, i As Long Dim cb, f As Range Set historyWks = Worksheets("NameList") If FileNameTxt.Value = "" Then MsgBox "Please choose a file name" WinOSBtn.Value = False ExportButton.Locked = True ExportButton.BackColor = RGB(250, 250, 250) ExportButton.ForeColor = RGB(220, 220, 220) FileNameTxt.SetFocus Exit Sub Else ExportButton.Locked = False ExportButton.BackColor = RGB(241, 241, 241) ExportButton.ForeColor = RGB(0, 0, 0) End If 'Add a new workbook with a file name Set newWB = Workbooks.Add() newWB.SaveAs Filename:=FileNameTxt.Value & ".xls" Set newSht = newWB.Sheets(1) For i = 1 To 21 Set cb = Me.Controls("ComboBox" & Chr(64 + i)) If Len(cb.Value) > 0 Then 'always worth specifiying to check the complete value.... Set f = historyWks.Range("A1:AM1").Find(cb.Value, lookat:=xlWhole) If Not f Is Nothing Then 'located the header - copy over With historyWks .Range(f, .Cells(.Rows.Count, f.Column).End(xlUp)).Copy End With With newSht.Cells(1, i) .PasteSpecial xlPasteAll .PasteSpecial xlPasteValues End With End If End If Next i 'rest of code here... End Sub
你定义CBA就像YourWorkbookName.sheets（yourSheetName）.Range（“A1：AM1”）。find（ComboBoxA.Value）我认为运行这个没有错误。
我正在使用一个Class在这里工作（不知道这是一个更好的解决scheme），类Module的名称是“cFindComboValue”
cFindComboValue类模块代码
Private myfRng As Range Public ComboVal As Variant Public Property Get fRng() As Range Set fRng = myfRng End Property Public Property Set fRng(objRng As Range) Set myfRng = objRng.Find(ComboVal, LookAt:=xlWhole) End Property
其余的代码和你的代码一样。 为了避免你得到的错误，你需要陷阱Find方法找不到任何东西的可能性，所以添加行If not FindRng is Nothing确定我们只复制成功的“查找”。
Sub ExportButton代码
Option Explicit Private Sub ExportButton_Click() Dim newWB As Workbook Dim historyWks As Worksheet Dim PasteSht As Worksheet Dim Ctl As Control Dim FindRng As cFindComboValue Dim Col As Long ' set FindRng as New cFindComboValue (Class) Set FindRng = New cFindComboValue Set historyWks = Worksheets("NameList") ' --- Haven't touched this section --- If FileNameTxt.value = "" Then MsgBox "Please choose a file name" WinOSBtn.value = False ExportButton.Locked = True ExportButton.BackColor = RGB(250, 250, 250) ExportButton.ForeColor = RGB(220, 220, 220) FileNameTxt.SetFocus Else ExportButton.Locked = False ExportButton.BackColor = RGB(241, 241, 241) ExportButton.ForeColor = RGB(0, 0, 0) End If 'Add a new workbook with a file name Set newWB = Workbooks.Add() newWB.SaveAs Filename:=FileNameTxt.value & ".xls" Set PasteSht = newWB.Sheets("Sheet1") ' kept "Sheet1" as your destination Paste sheet ' reset Paste Column to "A" Col = 1 ' loop through all Controls in User Form For Each Ctl In Me.Controls If TypeOf Ctl Is ComboBox Then ' check if current control is ComboBox If Ctl.value <> "" Then ' pass the ComboBox value to the Class FindRng.ComboVal = Ctl.value ' set the FindRange property of the class Set FindRng.fRng = historyWks.Range("A1:AM1") ' Find method was Successful If Not FindRng.fRng Is Nothing Then With historyWks ' copy from FindRng untill last row in that column , "pass" the empty cells in the middle .Range(FindRng.fRng, .Cells(.Rows.Count, FindRng.fRng.Column).End(xlUp)).Copy End With With PasteSht.Cells(1, Col) .PasteSpecial xlPasteAll .PasteSpecial xlPasteValues End With Col = Col + 1 ' I am moving one Column only if Find was Successful , avoid having empty columns End If End If End If Next Ctl ' use your original code here ' .... End Sub
再次感谢@TimWilliams的帮助。
这就是我所做的：
Public Sub ExportButton_Click() Dim inputWks As Worksheet Dim historyWks As Worksheet Dim newWB As Workbook, newSht As Worksheet, i As Long Dim cb, f As Range Set historyWks = Worksheets("NameList") Set inputWks = Worksheets("UserForm") If FileNameTxt.Value = "" Then MsgBox "Please choose a file name" WinOSBtn.Value = False ExportButton.Locked = True ExportButton.BackColor = RGB(250, 250, 250) ExportButton.ForeColor = RGB(220, 220, 220) FileNameTxt.SetFocus Exit Sub '==> Is there a reason why i'm putting this "Exit Sub" here? Else ExportButton.Locked = False ExportButton.BackColor = RGB(241, 241, 241) ExportButton.ForeColor = RGB(0, 0, 0) End If 'Prompts for a file name If FileNameTxt.Value = "" Then MsgBox "Please choose a file name" Else '===================================================================== ' Original Worksheet Add '===================================================================== 'Add a new workbook with a file name 'Workbooks.Add 'ActiveWorkbook.SaveAs Filename:=FileNameTxt.Value & ".xls" 'ActiveWorkbook.Close 'Workbooks.Open (FileNameTxt.Value & ".xls") 'Set newWB = Workbooks(FileNameTxt.Value & ".xls") 'Test Worksheet Add => Still to test on OSX Set newWB = Workbooks.Add() newWB.SaveAs Filename:=FileNameTxt.Value & ".xls" Set newSht = newWB.Sheets(1) For i = 1 To 21 Set cb = Me.Controls("Combobox" & Chr(64 + i)) If Len(cb.Value) > 0 Then Set f = historyWks.Range("A1:AM1").Find(cb.Value, lookat:=xlWhole) If Not f Is Nothing Then With historyWks .Range(f, .Cells(.Rows.Count, f.Column).End(xlUp)).Copy End With With newSht.Cells(1, i) .PasteSpecial xlPasteAll .PasteSpecial xlPasteValues End With End If End If Next i ExportForm.Hide Dim iMsg As Long iMsg = MsgBox("Export Complete", vbOKOnly) If i = vbOK Then Unload Me End If End If End Sub