Excel Vb Dropdownliste Update

Question

Ich bin ein Mewbie hier hoffe, jemand kann helfen. Ich habe Quellarbeitsmappe mit Dropdownliste in B: 3 und Daten in B10: K50. Arbeitsbuch2; Destination Arbeitsmappe ist von wo ich den Code ausführen muss, das ist auch, wo ich alle Blätter mit dem gleichen Namen wie aus der Dropdown-Liste Quelle wb haben.

Was ich erreichen möchte, ist ::: Arbeit durch Dropdown-Liste ist Quelle wb, Update-Daten depending auf Dropdown-Wert, kopieren Sie den Bereich B10: K50, Ziel-Arbeitsmappe öffnen, suchen Blattname (wie aus Dropdown-Text) und einfügen Daten von A1.

Gehen Sie zurück zu Quelle wb und wiederholen Sie bis zum letzten Wert von Dropdown-Liste. Code Ich benutze ist unten, aber das Problem ist, es ist einfach nicht Wert in Dropdownlist B Aktualisierung: 3:

Dim inputRange As Range 
Dim c As Range 
Dim WS_Count As Integer 
Dim I As Integer 
WS_Count = ActiveWorkbook.Worksheets.Count 
Dim Source As Range 
Dim dd As DropDown 
'Worksheets("Refurbs Tracker.xlsx").Select 
Windows("Refurbs Tracker.xlsx").Activate 
'[B3] = c.Value 
'Worksheets("Refurbs Tracker.xlsx").Select 
''Range("B3").Select******************************************************************************* 
    Set inputRange = Evaluate(Range("B3").Validation.Formula1) 
    '''***********************************************************Range("B3").Value = c.Value 
For Each c In inputRange 
    [B3] = c.Value 
    'Range("B3").Value = c.Value 
    'you might need to refresh the sheet here 
    ActiveSheet.Calculate 
    'Copy and PasteSpecial between workbooks 

    Workbooks("Refurbs Tracker.xlsx").Worksheets("Front Sheet").Range("b1:k50").Copy 
    Windows("Combined.xlsm").Activate 
    Sheets(c.Value).Select 
    'Sheets("151 MC Paisley").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 
    Cells.Select 
    Cells.EntireColumn.AutoFit 
    Range("A1").Select 
    ' Begin the loop. 
    'For I = 1 To WS_Count 

    'ThisWorkbook.Worksheets(I).Select 
    'Source.Copy 
    'Range("B1:K50").Select 
    'ActiveSheet.Paste 

    'Next I 
Next c 
'Disable marching ants around copied range 
Application.CutCopyMode = False 

Answer 1

Es ist offensichtlich, aus dem Code, den Sie viele Dinge ausprobiert. Ein paar Kommentare:

1. Es ist gute Praxis zu vermeiden, aktivieren und wählen. Definieren Sie stattdessen Objekte, die explizit das sind, was Sie verwenden möchten. Im folgenden Code habe ich ein SourceWB (Quellarbeitsmappe), ein DestWB (Zielarbeitsmappe), ein SourceSht (Blatt mit erforderlichen Informationen in SourceWB) und ein DestSht (Blatt in DestWB, in dem Information abgelegt wird) definiert. Im Abschnitt "Initial" des Codes müssen Sie die Namen entsprechend ändern - ich habe Namen verwendet, die zu dem kleinen Problem passen, das ich getestet habe.
2. Sie haben versucht, den Wert B3 im SourceSht zu ändern. Anstelle dieses Ansatzes finde ich im folgenden Code den Bereich der Validierungsliste, die für B3 verwendet wird, und verwende die Daten direkt aus diesem Bereich.
3. In Ihrem Code gehen Sie davon aus, dass der Blattname (wie im Validierungslistenbereich definiert) existiert. Ich überprüfe, ob es existiert, und erstelle das Blatt, wenn dies nicht der Fall ist.
4. Sie können einige andere Aktionen in Erwägung ziehen: Löschen von Daten im Zielblatt, bevor Werte in das Zielblatt eingefügt werden; Einstellung Application.ScreenUpdating = False am Anfang der Routine und Application.ScreenUpdating = True am Ende, um den blinkenden Bildschirm zu vermeiden.

Der Code ...

Sub myTest() 
Dim SourceWB As Workbook, DestWB As Workbook 
Dim SourceSht As Worksheet, DestSht As Worksheet 
Dim c As Range, myListRng As Range 
Dim myListStr As String 

' Initial 
    Set SourceWB = Workbooks("Book1") ' <~~ Use your Source Workbook name - "Refurbs Tracker" ? 
    Set DestWB = Workbooks("Book2")  ' <~~ Use your Destination Workbook name - "Combined" ? 
    Set SourceSht = SourceWB.Worksheets("Sheet1") ' <~~ Use your Source Sheet name - "Front Sheet" ? 

' find the drop down values 
    If SourceSht.Range("B3").Validation.Type = xlValidateList Then 
     myListStr = Mid(SourceSht.Range("B3").Validation.Formula1, 2) 
     Set myListRng = SourceWB.Names(myListStr).RefersToRange 
    Else 
     MsgBox "Problem with Validation List" 
     Exit Sub 
    End If 

' loop through the drop down values and do work 
    For Each c In myListRng 
     If SheetExists(c.Value, DestWB) Then 
      Set DestSht = DestWB.Worksheets(c.Value) 
     Else 
      Set DestSht = DestWB.Worksheets.Add 
      DestSht.Name = c.Value 
     End If 
     SourceSht.Range("B10:K50").Copy 
     DestSht.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ 
      SkipBlanks:=False, Transpose:=False 
    Next c 
    Application.CutCopyMode = False 

' Clean up 
    Set SourceSht = Nothing 
    Set DestSht = Nothing 
    Set SourceWB = Nothing 
    Set DestWB = Nothing 

End Sub 

... und die unterstützende Funktion ...

Function SheetExists(Name As String, WB As Workbook) As Boolean 
Dim WS As Worksheet 
    SheetExists = False 
    For Each WS In WB.Worksheets 
     If Name = WS.Name Then 
      SheetExists = True 
      GoTo CleanUp: 
     End If 
    Next WS 
CleanUp: 
    Set WS = Nothing 
End Function 

---

Update - basierend auf keinen benannten Bereich für die Validierung mit

Der Code unten funktioniert, wenn ein benannter Bereich oder eine Bereichsreferenz für die Validierung von Zelle B3 verwendet wird.

Sub myTest() 
Dim SourceWB As Workbook, DestWB As Workbook 
Dim SourceSht As Worksheet, DestSht As Worksheet 
Dim c As Range, myListRng As Range 
Dim myListStr As String, myShtStr As String, myRngStr As String 

' Initial 
    Set SourceWB = Workbooks("Book1") ' <~~ Use your Source Workbook name - "Refurbs Tracker" ? 
    Set DestWB = Workbooks("Book2")  ' <~~ Use your Destination Workbook name - "Combined" ? 
    Set SourceSht = SourceWB.Worksheets("Sheet1") ' <~~ Use your Source Sheet name - "Front Sheet" ? 

' find the drop down values 
    If SourceSht.Range("B3").Validation.Type = xlValidateList Then 
     myListStr = Mid(SourceSht.Range("B3").Validation.Formula1, 2) 
     On Error Resume Next 
     Set myListRng = SourceWB.Names(myListStr).RefersToRange 
     If Err.Number <> 0 Then 
      myShtStr = Left(myListStr, InStr(1, myListStr, "!") - 1) 
      myRngStr = Right(myListStr, Len(myListStr) - Len(myShtStr) - 1) 
      myShtStr = Replace(myShtStr, "'", "") 
      Set myListRng = SourceWB.Worksheets(myShtStr).Range(myRngStr) 
     End If 
     On Error GoTo 0 
    Else 
     MsgBox "Problem with Validation List" 
     Exit Sub 
    End If 

' loop through the drop down values and do work 
    For Each c In myListRng 
     If SheetExists(c.Value, DestWB) Then 
      Set DestSht = DestWB.Worksheets(c.Value) 
     Else 
      Set DestSht = DestWB.Worksheets.Add 
      DestSht.Name = c.Value 
     End If 
     SourceSht.Range("B10:K50").Copy 
     DestSht.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ 
      SkipBlanks:=False, Transpose:=False 
    Next c 
    Application.CutCopyMode = False 

' Clean up 
    Set SourceSht = Nothing 
    Set DestSht = Nothing 
    Set SourceWB = Nothing 
    Set DestWB = Nothing 

End Sub