Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Excel VBA Werte kopieren in Bereich

Betrifft: Excel VBA Werte kopieren in Bereich von: Romeo
Geschrieben am: 02.11.2020 19:23:42

Hallo Excel Experten ;-)


Ich komme wieder mal nicht weiter mit einem Excel-Makro.

Ich möchte mit VBA, Werte aus einer Spalte in einen vorgegebenen Bereich mit mehreren Spalten und Zeilen kopieren.


Ich habe in Sheet(PLOs COOIS) in Spalte ("C" & 2, "C" & 18) 17-Artikelnr. welche ich in Sheet(TTP) in den Bereich ("A" & 4, "E" & 11) kopieren möchte. Der Bereich kann jedoch nicht vergrössert werden. Die Anzahl zu kopierenden Artikelnr. sind immer unterschiedlich, aber nie mehr als die Anzahl Zellen in den zu kopierenden/vorgegebenen Bereich.


Die gesamte Excel-Datei wird zur Produktionsplanung genutzt und bis jetzt habe ich diesen Vorgang immer manuell durchgeführt und dies bei 21 Dateien. Bei einigen Dateien sind dies sogar mehr als über 100 Artikelnr. welche ich manuell kopieren muss.

Daher würde mir ein Makro einiges an Zeit ersparen.


Hat jemand eine Idee/Lösung für mein Problem?



Hier meine Datei: https://www.herber.de/bbs/user/141257.xlsm




Ich danke schon im Voraus für jede Hilfe!


Gruss Romeo

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: onur
Geschrieben am: 02.11.2020 20:03:14

Und was sollen wir mit einer passwortgeschützten Datei?

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: Romeo
Geschrieben am: 02.11.2020 20:40:42

Hallo onur

Die Datei soll auch nur als Hilfe dienen, damit ihr meine Beschreibung besser versteht. Doch wenn jemand die Datei für Testzwecke ungeschützt benötigt, dann kann ich diese auch hochladen?! ...kein Problem.
Ich dachte nur dass es zum Verständnis so ausreichen würde.

Gruss

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: ralf_b
Geschrieben am: 02.11.2020 20:15:23


Sub PLO_to_TTP()
  Dim arPLO, i As Integer, x
  
  arPLO = Worksheets("PLOs COOIS").Range("C2:C18")
  

    With ThisWorkbook.Worksheets("TTP")
    
        i = 1
        For Each x In .Range("A4:E11")
          
            
            If i > UBound(arPLO) Then Exit For
            
            x.Value = arPLO(i, 1)
            
            i = i + 1
         
         Next
    End With
    
Erase arPLO
End Sub


Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: Romeo
Geschrieben am: 02.11.2020 20:48:05

Hallo ralf_b

Danke für den schnellen Lösungsvorschlag.
Ich muss sagen, ich verstehe bei deinem Makro nur Bahnhof. Doch ich werde es gleich testen und werde dann gleich ein Feedback geben.

Danke und Grüsse

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: ralf_b
Geschrieben am: 02.11.2020 21:00:49

nur Bahnhof? und dabei sind es ganz wenige Zeilen

wer hat denn die anderen Makros geschrieben?

arPLO is ein datenfeld oder Array das die Werte aus dem PLO bereich enthält
i ist eine Zählvariable mit der ich auf die Indizes des Datenfeldes zugreife

for each ist die schleife durch alle Zellen im TTP bereich

x repräsentiert die jeweils angesprochene Zelle im TTP bereich

if i .. bricht die Schleife ab wenn das Ende des Datenfeldes erreicht ist.

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: Romeo
Geschrieben am: 02.11.2020 21:08:42

nur Bahnhof ist übertrieben gesagt... wie du bereits erklärt hast das "arPLO" habe ich nicht verstanden und auch das "UBound" und "Erase" verstehe/kenne ich nicht.

Die anderen Makros, die gesamte Datei habe schon ich erstellt.


Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: Romeo
Geschrieben am: 02.11.2020 22:33:34

...es funzt!!! Ich habe dein Makro soeben getestet und es macht genau was ich mir vorgestellt habe.
Danke dir vielmals für die super schnelle Antwort/Lösung!!!

Kannst du mir noch kurz "UBound" und "Erase" erklären? Denn ich muss dieses Makro noch in weiteren Dateien einpflegen und z.T. muss ich es anpassen, da manche Dateien mehrere Bereiche in Sheet(TTP) haben wo ich die Artikelnr. einkopieren möchte.

Danke und Gruss

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: ralf_b
Geschrieben am: 02.11.2020 23:47:41

Lbound u. Ubound zeigen die unte- und obergrenze eines Arrays, prakisch für schleifen
Erase gibt den Speicherplatz frei

https://www.informatik-aktuell.de/entwicklung/programmiersprachen/excel-vba-im-zusammenspiel-mit-arrays.html

https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/erase-statement

https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/ubound-function

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: ralf_b
Geschrieben am: 02.11.2020 23:47:43

Lbound u. Ubound zeigen die unte- und obergrenze eines Arrays, prakisch für schleifen
Erase gibt den Speicherplatz frei

https://www.informatik-aktuell.de/entwicklung/programmiersprachen/excel-vba-im-zusammenspiel-mit-arrays.html

https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/erase-statement

https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/ubound-function

Betrifft: AW: Excel VBA Werte kopieren in Bereich
von: Romeo
Geschrieben am: 03.11.2020 01:21:27

Vielen Dank ralf_b... jetzt habe ich wieder etwas gelernt.

Betrifft: danke für die rückmeldung -owT
von: ralf_b
Geschrieben am: 03.11.2020 08:48:30



Betrifft: AW: danke für die rückmeldung -owT
von: Romeo
Geschrieben am: 04.11.2020 20:20:16

Hallo ralf_b / zusammen

Der Code von ralf_b hat bei meiner ersten Datei einwandfrei funktioniert und dies auch bei mehreren Tests. Nun wollte ich bei allen anderen Planungs-Dateien ebenfalls dieses Makro einpflegen.

Bei der zweiten hat es noch funktioniert und jetzt bei der dritten Datei wird immer ein "Laufzeitfehler'13': Typen unverträglich" angezeigt obwohl ich genau denselben Code verwende bis an eine andere Range.

Ich habe bereits mehrere Varianten ausprobiert, doch ich finde einfach keinen Fehler!
Es scheint mir bei beiden Dateien alles identisch zu sein, doch bei einer Datei funzt es und bei der anderen eben nicht.

Ich habe mal beide Dateien hochgeladen... könnt ihr mir bitte helfen?

https://www.herber.de/bbs/user/141319.xlsm

https://www.herber.de/bbs/user/141320.zip


Danke euch im Voraus für eure Mühe und Hilfe...

Betrifft: Anpassung -owT
von: ralf_b
Geschrieben am: 04.11.2020 23:00:31


Sub PLOs_to_KiraD()

Dim arPLO, i As Integer, x As Range, rBereich As Range

Worksheets("PLOs COOIS").Unprotect ("xxx")

With Worksheets("PLOs COOIS")

    Set rBereich = .Range("C2:C" & .Cells(Rows.Count, "C").End(xlUp).Row)
    
    ReDim arPLO(1 To rBereich.SpecialCells(xlCellTypeVisible).Count)
    
    For i = 1 To rBereich.SpecialCells(xlCellTypeVisible).Count
      arPLO(i) = rBereich.SpecialCells(xlCellTypeVisible).Cells(i).Value
    Next
End With

With ThisWorkbook.Worksheets("TTP")

    i = 1
    
    For Each x In .Range("A13:E17")
        If i > UBound(arPLO) Then Exit For
        x.Value = arPLO(i)
        i = i + 1
    Next
End With

 Erase arPLO
Set rBereich = Nothing: Set x = Nothing

Worksheets("PLOs COOIS").Protect ("xxxx")


End Sub


zusätzlich hätte ich eine Idee für dich
du kopierst den Code mehrfach um unterschiedliche Bereiche zu kopieren.
Mit einer kleinen Änderung könntest du den Code übersichtlicher und leichter pflegbar machen.
Wenn du der Kopierroutine PlOs_to_TTP den Bereich als Parameter übergibst, dann würde für die unterschiedlichen Bbereich nur ein kleiner Aufruf genügen
Sub KiraD()
  Call PLOs_to_TTP("A13:E17")
End Sub

Sub KiraD()
  Call PLOs_to_TTP("A33:E39")
End Sub


Änderung in der kopierroutine
Sub PLOs_to_TTP(sArea As String) ' der Aufruf

  For Each X In .Range(sArea)  'die Anpassung an der Schleife



Betrifft: AW: Anpassung -owT
von: Romeo
Geschrieben am: 05.11.2020 08:40:16

Guten Morgen ralf_b / zusammen

Das mit dem Call Aufruf ist eine super Idee.

Ich habe genau deinen Code kopiert und die Variante mit dem Call Aufruf habe ich in der Datei, welche mehrere Bereiche hat, ebenfalls umgestetzt. Doch genau bei der Datei mit mehreren Bereichen funktioniert es nicht. Es kopiert Werte welche aber in "PLOs COOIS" in Spalte "C" nicht gefiltert sind. (nur zwei Werte wurden korrekt aus dem gefilterten Bereich kopiert und die restlichen sind falsch)

Dieses Makro bringt mich noch ins Grab.


Hast du eine Idee ralf_b oder sonst jemand?

Betrifft: AW: Anpassung
von: ralf_b
Geschrieben am: 05.11.2020 08:49:36

Wie wäre es wenn das Makro auch das Filtern erledigen würde? Anhand der Wochennummer in TTP!G5 und dem Schaltflächennamen Ist das machbar. Nur weis ich nicht ob du den Ablauf immer so benötigst.



Betrifft: AW: Anpassung
von: Romeo
Geschrieben am: 05.11.2020 09:05:31

Ist mir auch schon in den Sinn gekommen, aber ich brauche eben nicht immer diesen Ablauf. Doch die Variante mit "SpecialCells(xlCellTypeVisible)" müsste doch eigentlich funktionieren. Ich verstehe nicht dass es bei der ersten Datei einwandfrei funktioniert und bei der zweiten nicht?!
Ich google mal nach einer weiteren Möglichkeit.

Oder hast du noch eine Idee?

Betrifft: AW: Anpassung
von: ralf_b
Geschrieben am: 05.11.2020 08:49:38

Wie wäre es wenn das Makro auch das Filtern erledigen würde? Anhand der Wochennummer in TTP!G5 und dem Schaltflächennamen Ist das machbar. Nur weis ich nicht ob du den Ablauf immer so benötigst.



Betrifft: AW: Anpassung 2
von: ralf_b
Geschrieben am: 05.11.2020 09:02:02

Nobody is perfekt.

Mir ist aufgefallen das der Specialcells Bereich in der gefilteren Liste nicht immer ein zusammenhängender Bereich ist. Deshalb funktioniert es manchmal mit der ersten Version weil der gefilterte Bereich lückenlos untereinander steht.

Sobald Zeilen ausgeblendet werden besteht specialcells aus mehreren Areas. Diese müßten über Umwege ausgewertet werden. Alternativ kann man eine Schleife über deinen Filterbereich laufen lassen und nur die Werte aus den sichtbaren Zeilen nehmen.

Betrifft: AW: Anpassung 2
von: Romeo
Geschrieben am: 05.11.2020 09:13:23

Kein Problem... ich bin froh dass du mir hilfst.
Und wie würde die Schleife aussehen? Hast du Zeit mir das zu zeigen?
Ich bin bei diesem Makro am Ende meines Latein. Ich habe in den letzten Tagen das erste mal Guixt-Scipte (SAP Schnittstelle zu Excel) programmiert und jetzt bin ich wahrscheinlich einfach zu müde um zu denken ;-)
Wäre dir sehr dankbar...

Betrifft: AW: Anpassung 2
von: ralf_b
Geschrieben am: 05.11.2020 09:56:46

Sub KiraE()
  Dim sMaschine As String
  
  sMaschine = ThisWorkbook.Worksheets("TTP").Shapes("Button 4").AlternativeText

  Call PLOs_to_TTP("A22:E28", sMaschine)
End Sub

Sub PLOs_to_TTP(sArea As String, sMaschine As String)

Dim arPLO, X As Range, rBereich As Range, sKw  As String

Application.ScreenUpdating = False
  
sKw = ThisWorkbook.Worksheets("TTP").Range("G5").Value  ' Wochennummer

With Worksheets("PLOs COOIS")
    
    .Unprotect ("Dior.sora.1988")
    
    Set rBereich = .Range("C2:C" & .Cells(Rows.Count, "C").End(xlUp).Row)
    
    If .FilterMode Then .ShowAllData: rBereich.AutoFilter  'Vorherigen Fiter zurücksetzen
    
    'Die Zwei Filter anwenden
    rBereich.Rows(1).Offset(-1).AutoFilter Field:=15, Criteria1:=sKw
    rBereich.Rows(1).Offset(-1).AutoFilter Field:=17, Criteria1:=sMaschine
    
   'schleife über Filterbereich
    ReDim arPLO(1 To 1)
    cnt = 1
    For Each X In rBereich.Rows
      If X.Height > 0 Then   'wenn Zeile sichtbar
         ReDim Preserve arPLO(1 To cnt)
         arPLO(cnt) = X.Value
         cnt = cnt + 1
      End If
    Next
    Set X = Nothing
     .ShowAllData: rBereich.AutoFilter
End With


'kopieren in TTP
With ThisWorkbook.Worksheets("TTP")

    i = 1
    .Range(sArea).ClearContents
    For Each X In .Range(sArea)
        If i > UBound(arPLO) Then Exit For
        X.Value = arPLO(i)
        i = i + 1
    Next
End With

Erase arPLO
Set rBereich = Nothing: Set X = Nothing

Application.ScreenUpdating = True

Worksheets("PLOs COOIS").Protect ("Dior.sora.1988")


End Sub


Betrifft: AW: Anpassung 3
von: ralf_b
Geschrieben am: 05.11.2020 10:13:03

Wieder mal was vergessen
Das muß noch hinten an die Dim Anweisung in der Kopiersub. Ich empfehle Option Explicit am Anfang der Codeabschnitte zu setzen. Dann meckert der Compiler wenn sowas fehlt.
 cnt As Integer, i As Integer

Was ist eigentlich wenn die Filterergebnisse doppelt vorkommen? Also das gleiche Produkt und sollen die Produktionszeiten nicht auch noch einen Einfluß für die Zuordnung zu den Tagen haben?

Betrifft: AW: Anpassung 3
von: Romeo
Geschrieben am: 05.11.2020 10:38:08

Eh vielen Dank für deine Mühe. Du kennst mich nicht mal und gibst dir alle Mühe mir zu helfen.

Ich werde den Code gleich ausprobieren und gebe dann ein Feedback.

Doppelte Filterergebnisse (Artikelnr.) müssen zwingend berücksichtigt werden. Doch die Produktionszeiten haben beim Makro keinen Enfluss, die kopierten Artikelnr. werde ich dann manuell noch auf die Tage einteilen da zuviele Kriterien nötig wären und dies bei jeder Datei unterschiedlich.
Ich spare schon viel Zeit wenn die Artikelnr. per Makro in TTP kopiert werden. Z.b. bei der ersten Datei ist dies eine kleine Zeitersparnis, jedoch habe ich Dateien mit mehr als 100 zu kopierenden Artikelnr. und das auf mehrere Maschinen, da wird dann die Zeitersparnis schon viel mehr sein.

Werden bei diesem Code bereits doppelte Werte berücksichtigt?

Betrifft: AW: Anpassung 3
von: ralf_b
Geschrieben am: 05.11.2020 11:09:44

es wird so eingefügt wie es gefiltert wurde. Doppelte inclusive.

Es ist auch etwas Eigennutz dabei. Learning by doing.

Wenn vba dir noch mehr Arbeit abnehmen soll, dann muß vba wissen was du alles vorhast. Im Grunde würde sich der Code dann komplett anders aufbauen, falls noch Kriterien die Auswahl beeinflussen.

z.B. Könnte die Produktionszeit an den Produktnamen angehangen werden. somit siehts du direkt im Blatt TTP beim Umsortieren wieviel Zeit du an dem Tag schon reinkopiert hast.

Betrifft: AW: Anpassung 3
von: Romeo
Geschrieben am: 08.11.2020 13:56:14

Hallo ralf_b

Leider bin ich erst heute dazu gekommen deinen Code zu testen. Nun funktioniert alles einwandfrei... danke dir vielmals für deine Hilfe.

Eins, zwei Code-Abschnitte muss ich noch genau anschauen und ggf. googeln, denn die verstehe ich nicht ganz und ich möchte den Code nicht einfach nur copy and paste und fertig, ich möchte ihn auch verstehen.

Und falls du Lust hast weiter zu programmieren und dabei für dich etwas zu lernen und zugleich mir zu helfen, könnte ich dir mal von einer Datei die Kriterien mitteilen, welche für das Einteilen der Artikelnr. in TTP nötig wären. Doch ich denke dies würde einen ziemlichen Aufwand ergeben.
Aber ist auch kein Problem wenn du keine Lust dazu hast.

Danke und ich wünsche einen schönen Sonntag

Betrifft: danke für die rückmeldung .....
von: ralf_b
Geschrieben am: 08.11.2020 15:07:22

.... was ist denn unklar? Einfach fragen.

Das mit dem TTP kann ich mir ja mal anschauen. schlimmer als "Nein" zu sagen kanns nicht werden.

Gruß RB

Betrifft: AW: danke für die rückmeldung .....
von: Romeo
Geschrieben am: 10.11.2020 22:36:55

Hallo zusammen und ralf_b

Ich hab da noch ein kleines Problem... In einer dieser Planungs-Datei hat es 5-Maschinen und alle Maschinen werden in Sheet "PLOs COOIS" auch als gleiche gefiltert. Wäre ja kein Problem mit dem Makro von ralf_b, aber i.d.R werden in dieser Datei ca.100 Artikelnr. aus Sheet "PLOs COOIS") in jene 5-Maschinen (in Sheet "TTP") kopiert aber jede Maschine hat nur 6-Zeilen zur Verfügung. Das heisst ich kann mit: Call PLOs_to_TTP("A13:E17", sMaschine) nur einen Bereich angeben und das ist das Problem.

Meine Lösung: wenn zuerst eine Maschine mit Artikelnr. gefüllt wird und dann die zweite Maschine usw.
Aber hierfür habe ich keine Lösung wie es im Code umsetzen. Hat jemand eine Idee?

@ralf_b bis an die oben genannte Datei sind alle mit deinem Makro ausgerüstet und alles funktioniert prima. An drei, vier Dateien musste ich noch einige Anpassungen machen, aber sonst wie gewünscht. Immerhin verstehe ich jetzt deine Code ;-)

Danke und Gruss

Betrifft: AW: danke für die rückmeldung .....
von: ralf_b
Geschrieben am: 10.11.2020 23:39:59

na dann auf ein Neues. Versuchs mal mit den mehreren Bereichen.


Aufruf
 Call PLOs_to_TTP("A22:A28,A33:A39,A13:A17", sMaschine)
in PLOs_to_TTP
Dim arAreas,  y

'kopieren in TTP
With ThisWorkbook.Worksheets("TTP")
   
    If InStr(1, sArea, ",") > 0 Then
         arAreas = Split(sArea, ",")
    Else
        arAreas = sArea
    End If
    
    i = 1
    For Each y In arAreas
    
        .Range(y).ClearContents
        For Each X In .Range(y)
            If i > UBound(arPLO) Then Exit For
            X.Value = arPLO(i)
            i = i + 1
        Next
        
     Next
     If (i - 1) < UBound(arPLO) Then
        MsgBox "Warnung:  Kein freier Platz für Eintragungen vorhanden"
     
End With


Betrifft: AW: danke für die rückmeldung .....
von: Romeo
Geschrieben am: 11.11.2020 01:21:40

Danke für die schnelle Antwort. Ich weiss nicht wie du das so schnell hinkriegst?!

Debugger meldet "End With ohne With" bei dem neu gezeigten Teilcode??!

Etwas stimmt noch nicht...

Betrifft: AW: danke für die rückmeldung .....
von: Romeo
Geschrieben am: 11.11.2020 01:28:34

Sorry ich war zu schnell... es hat ein "End If" im letzten Abschnitt unter MsgBox gefehlt und darum der Fehler "End With ohne With"

Danke und Gute Nacht

Beiträge aus dem Excel-Forum zum Thema "Excel VBA Werte kopieren in Bereich"