Office: (Office 2016) VBA- Projektname aus Importdatei kopieren und in anderes Tabellenblatt einfügen

Helfe beim Thema VBA- Projektname aus Importdatei kopieren und in anderes Tabellenblatt einfügen in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, ich habe heute schon ein paar Stunden an meiner Excel Tabelle gebastelt, aber nun brauch ich doch bitte eure Hilfe: Ich habe zwei... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Swift1987, 26. Juli 2019.

  1. VBA- Projektname aus Importdatei kopieren und in anderes Tabellenblatt einfügen


    Hallo zusammen,

    ich habe heute schon ein paar Stunden an meiner Excel Tabelle gebastelt, aber nun brauch ich doch bitte eure Hilfe:

    Ich habe zwei Tabellenblätter (Overview & Import). In Import wird eine systemgenerierte Liste als Werte eingefügt.
    Overview hat die folgenden Buttons:

    1. Vorbereitung der Importtabelle (Merge aus, Spalten löschen, etc.) -> funktioniert
    2. Import Daten (Spalte A bis G wird aus Import übernommen) -> funktioniert
    3. Alle Daten aus Overview löschen -> funktioniert
    4. Projektname importieren (fixe Zelle in Import wird den importierten Zeilen in Overview zugeordnet) -> funktioniert teilweise, aber nicht wie ich es will

    Mein Problem ist, dass ich den Import für 3. für mehrere Projekte durchführen muss und alles schön untereinander in Overview angezeigt werden soll.
    Der Import der Projektnamen funktioniert beim ersten mal gut.
    Wenn ich jetzt aber meinen Projektnamenimport zum 2-ten, 3-ten bzw. x-ten mal starte, überschreibt er mir alle Daten in Spalte H.

    Wo ist da der Wurm drin?

    Vielen Dank für eure Hilfe!

    Gruß,
    Florian

    Code:
    Private Sub cmdProjectImport_Click()
        Dim Project As String, lastrow1 As Long, i As Long, Col As Range
    
            lastrow1 = Sheets("Overview").Cells(Rows.Count, 1).End(xlUp).Row
               
          
       For i = 3 To lastrow1
        If Sheets("Overview").Cells(i, 1) Like ("A2*") Then
            With Sheets("Overview")
            lastrow1 = .Cells(Rows.Count, 8).End(xlUp).Row
            If lastrow1 < 2 Then lastrow1 = 2
            End With
            Sheets("Import").Cells(2, 4).Copy Destination:=Sheets("Overview").Cells(i, 8)
            End If
            
        Next i
             
    '*********************************************************************
    'Automatische Breite
        For Each Col In Sheets("Overview").UsedRange.Columns
        Col.AutoFit
        Next Col
        
    '*********************************************************************
    'Auto Filter
        If Not ActiveSheet.AutoFilterMode = True Then
        Range("A2:H2").AutoFilter
        End If
        
    '*********************************************************************
    'Clear Import
        Sheets("Import").Cells.Clear
        
        MsgBox "Project numbers have been transfered." & vbNewLine & "Import sheet cleared."
        
    End Sub
     
    Swift1987, 26. Juli 2019
    #1
  2. Exl121150 Erfahrener User
    Hallo,

    da ich nicht wirklich erkennen kann, was wo(hin) gespeichert ist, beschreibe ich, was dein Makro macht:
    1. In die Variable "lastrow1" wird die letzte Zeilennr. von Spalte A, die Daten enthält, gespeichert.
    2. Dann wird mittels Schleifenvariable "i" der Zeilenbereich von Zeile 3 bis zu Zeile "lastrow1" durchlaufen, indem
      • in Spalte A der i.Zeile überprüft wird, ob dort der Wert "A2..." gespeichert ist: falls ja, wird das Folgende ausgeführt (sonst übersprungen):
      • Es wird die letzte Datenzeile der Spalte H ermittelt und in Variable "lastrow1" gespeichert (Anmerkung: Dieser "lastrow1"-Wert beeinflusst NICHT die Schleifenvariable "i" !!!, denn deren Laufintervall wird in der FOR-Zeile festgelegt und kann dann nicht mehr geändert werden!!!)
      • Wird dabei festgestellt, dass "lastrow1"=1, dann wird "lastrow1" auf 2 gesetzt.
      • Im Anschluss an den WITH-Block wird dann Zelle D2 aus Arbeitsblatt "Import" in die Zelle von Zeile "i" und Spalte H des Blattes "Overview" kopiert
    Damit ist der Kopiervorgang aus Blatt "Import" einzig und allein von der Schleifenvariable "i" abhängig, die stets von 3 bis zur letzten in Spalte A verwendeten Zeile läuft, womit auch klar ist, dass der Zellbereich ab Zeile 3 der Spalte H immer wieder überschrieben wird bei mehrmaliger Makroausführung (sofern in Spalte A der Wert "A2..." enthalten ist).

    Ich vermute, dass das Makro in etwa wie folgt lauten müsste:
    Code:
    Private Sub cmdProjectImport_Click()
        Dim Project As String, lastRowA As Long, firstEmptyRowH As Long
        Dim i As Long, Col As Range
    
       With Sheets("Overview")
         lastRowA = .Cells(Rows.Count, 1).End(xlUp).Row
               
         For i = 3 To lastRowA
           If .Cells(i, 1) Like "A2*" Then
              firstEmptyRowH = .Cells(Rows.Count, 8).End(xlUp).Row + 1
              If firstEmptyRowH < 2 Then firstEmptyRowH = 2
              Sheets("Import").Cells(2, 4).Copy Destination:=.Cells(firstEmptyRowH, 8)
           End If
         Next i
         
       End With
    '....
    '...usw...
    End Sub
    
     
    Exl121150, 27. Juli 2019
    #2
  3. Hallo Anton Exl,

    nach deiner Erklärung macht es Sinn, dass mein Code keinen Sinn macht ;)
    Hatte schon die Befürchtung, dass meine Erklärung unklar war, aber deine Annahme wie der Code auszusehen hat war absolut richtig!
    Der Code funktioniert einwandfrei!

    Vielen vielen Dank!!!

    Gruß,
    Florian
     
    Swift1987, 29. Juli 2019
    #3
  4. VBA- Projektname aus Importdatei kopieren und in anderes Tabellenblatt einfügen

    Problem mit Zuordnung zwischen Tabellenblättern

    Hallo,

    ich habe ein weiteres Problem mit meiner Excel.

    Folgender Code funktioniert und vergleicht Art.-Nummern zwischen Sheet "Overview" und "Project_Import".
    Bei einem Match der Nummern kopiert der Code den zugehörigen Status des Artikels aus dem Import (Spalte K) in Overview (Spalte I)

    Wie gesagt der Code läuft und er ordnet auch zu, jedoch habe ich in den Art.-Nummern teilweise Duplikate, weil dort andere Lieferanten hinterlegt sind.

    Jetzt kopiert mir der Code aber den Status immer nur 1x zur ersten gefundenen Art.-Nr.

    Was muss geändert werden, dass alle Art.-Nr. auch den Status zugeordnet bekommen?

    Hoffe ihr könnt mir nochmal weiterhelfen!

    Danke!!!


    Code:
    Sub ProImportStatus()
    
    Dim calcStatus As Long
    Dim CelStatus As Range
    Dim LastRow As Long
    Dim rFoundStatus As Range
    Dim LookRange As Range
    Dim CelValueStatus As Variant
      
        'Get Last row of data Project_Import, Col B
        LastRow = Sheets("Project_Import").Cells(Rows.Count, 2).End(xlUp).Row
        
        ' Set range to look in
        Set LookRange = Sheets("Project_Import").Range("B1:B" & LastRow)
        
        ' Loop on each value (cellStatus)
        For Each CelStatus In LookRange
            ' Get value to find
            CelValueStatus = CelStatus.Value
            ' Look on Overview
            With Sheets("Overview")
                
                ' Allow not found error
                On Error Resume Next
        
                Set rFoundStatus = .Cells.Find(What:=CelValueStatus, _
                    After:=.Cells(4, 1), LookIn:=xlValues, _
                        Lookat:=xlWhole, MatchCase:=False)
             
                ' Reset
                On Error GoTo endo
                
                ' Not found, go next
                If rFoundStatus Is Nothing Then
                    GoTo nextCelStatus
                Else
                    ' Found. Copy Project_Import, Col K to Overview found Row, Col I
                    Sheets("Project_Import").Cells(CelStatus.Row, 11).Copy .Cells(rFoundStatus.Row, 9)
                End If
            End With
            
    nextCelStatus:
        Next CelStatus
        
    'Reset
        
    endo:
    
        With Application
            .Calculation = calcStatus
            .ScreenUpdating = True
        End With
    
    End Sub
     
    Swift1987, 12. August 2019
    #4
  5. Ein weiteres Problem ist aufgetaucht: Beim Import mehrerer Projekte löscht mir der o.g. Code immer den Status aus der ersten Datenzelle in Overview (in diesem Fall (4, 9)).
     
    Swift1987, 13. August 2019
    #5
  6. Exl121150 Erfahrener User
    Hallo,

    nachfolgend habe ich dein Makro für die mehrmalige Suche nach dem Wert CelValueStatus angepasst.
    Das habe ich auch bereits befürchtet bei der ersten Sichtung deines Codes. Das Problem besteht darin, dass du den Suchbereich der Methode "Find" auf das gesamte Arbeitsblatt "Overview" ausgedehnt hast, indem du programmierst ".Cells.Find(…)". Du gibst zwar als Startzelle ".Cells(4,1)" an, sodass die Suche ab der nächste Zelle (das ist Overview!B4) begonnen wird. Hast du aber zB. bei früheren Datenimporten bereits eine Datenkopie nach Zelle Overview!I4 ausgeführt und dieser Wert ist zufällig gleich mit dem jetzigen Suchwert CelValueStatus, so wird jetzt eine neuerliche Kopie in diese Zelle I4 (oder I5 etc.) durchgeführt. Darüber hinaus können noch weitere nicht gewünschte Zufallsfunde auftreten. Der Suchbereich sollte somit so klein wie möglich gehalten werden.
    Dabei kommt noch (erschwerend) hinzu: Haben die Methoden Find bzw. FindNext den gesamten Suchbereich durchsucht, beginnen sie wieder bei der ersten Zelle des Suchbereichs (unabhängig davon, was bei After:=… angegeben wurde) zu suchen - im Falle des gesamten Arbeitsblattes wieder bei A1.

    Es ist deshalb dringend ratsam, eine Entkoppelung des Suchbereichs und des Kopier-Zielbereichs (= Spalte I von Blatt "Overview") einzubauen. Da ich deine Datenstruktur im Arbeitsblatt "Overview" nicht kenne, konnte ich das nicht bereits einbauen. Ich vermute aber, dass sich der Suchbereich auf 1 Arbeitsblattspalte beschränken lässt.
    Aufgrund der Startzelle in ".Cells(4,1)" (=$A$4) vermute ich, dass dies Spalte A sein wird.
    Dann müsste die Zeile mit der Find-Methode lauten:
    Set rFoundStatus = .Columns("A").Find(What:=CelValueStatus, After:=.Cells(4, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
    und die Suche würde dann in Zelle A5 (als nächster Zelle im Suchbereich nach A4 statt wie bisher B4) starten.
    Ferner müsste die Zeile mit der FindNext-Methode lauten:
    Set rFoundStatus = .Columns("A").FindNext(After:=rFoundStatus)
    Code:
    Sub ProImportStatus()
    
    Dim calcStatus As Long
    Dim CelStatus As Range
    Dim LastRow As Long
    Dim rFoundStatus As Range, FirstFoundAddress As String
    Dim LookRange As Range
    Dim CelValueStatus As Variant
    Dim WsImport As Worksheet, WsOvView As Worksheet
    
        Set WsImport = Worksheets("Project_Import")
        Set WsOvView = Worksheets("Overview")
        
        With WsImport
          'Get Last row of data Project_Import, Col B
          LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
          ' Set range to look in
          Set LookRange = .Range("B1:B" & LastRow)
        End With
        
        ' Loop on each value (cellStatus)
        For Each CelStatus In LookRange
            ' Get value to find
            CelValueStatus = CelStatus.Value
            ' Look on Overview
            With WsOvView
        
                ' Sucht den Wert CelValueStatus ab der Zelle, die auf Overview!A4 folgt, also ab Zelle Overview!B4
                Set rFoundStatus = .[COLOR="#FF0000"]Cells[/COLOR].Find(What:=CelValueStatus, After:=.[COLOR="#FF0000"]Cells(4, 1)[/COLOR], LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
                If Not rFoundStatus Is Nothing Then
                   'Es gab einen ersten Zellfund -> Merke dir die Adresse dieser Zelle:
                   FirstFoundAddress = rFoundStatus.Address
                   Do
                     ' Found. Copy Project_Import, Col K to Overview found Row, Col I
                     WsImport.Cells(CelStatus.Row, 11).Copy .Cells(rFoundStatus.Row, 9)
                     ' Suche nach der nächsten Zelle im Suchbereich von Blatt "Overview" mit Wert CelValueStatus!
                     ' Da du als Suchbereich alle Zellen (.Cells) des Blattes "Overview" angegeben hast,
                     ' werden auch ALLE Zellen durchsucht. Dadurch kann es zu Konflikten mit nicht gewollten Zufallsfunden kommen!!!
                     ' Es ist daher dringend ratsam, den Suchbereich einzuschränken - zumindest auf einen Bereich, der außerhalb von Spalte I liegt.
                     ' Hat dabei die Methode "Suchbereich.FindNext" das ganze - wegen .Cells - Arbeitsblatt "Overview" durchsucht,
                     ' beginnt sie die Suche wiederum bei der ersten Zelle des Suchbereichs, also bei Overview!A1 (wegen .Cells.FindNext).
                     Set rFoundStatus = .[COLOR="#FF0000"]Cells[/COLOR].FindNext(After:=rFoundStatus)
                     ' Brich die wiederholte Suche dann ab, wenn es sich beim abermaligen Fund um den ersten Zellfund handelt:
                   Loop Until rFoundStatus.Address = FirstFoundAddress
                End If
                
            End With
            
        Next CelStatus
        
    'Reset
        
    endo:
    
        With Application
            .Calculation = calcStatus
            .ScreenUpdating = True
        End With
    
    End Sub
     
    Exl121150, 14. August 2019
    #6
  7. steve1da Office Guru
  8. VBA- Projektname aus Importdatei kopieren und in anderes Tabellenblatt einfügen

    Jetzt geht gar nichts mehr...Excel hängt sich jetzt auf und muss per Taskmanager gekillt werden...
    Die Punkte in rot habe ich auf Columns"A" geändert, da in Overview jeweils zu Spalte A in H und I zugeordnet werden soll.
    Zelle (4,1) weil in den Zeilen 1-3 die Buttons sowie Zeilenüberschriften stehen.

    Meine Datenstruktur in Overview ist wie folgt:

    Spalte A: Art.Nr.
    B: Bezeichnung
    C: Tracking Type
    D: Kategorie
    E: Lieferant
    F: Ansprechpartner
    G: Kritisch
    H: ABC Klasse
    I: Status
    J: Projekt
     
    Zuletzt von einem Moderator bearbeitet: 30. November 2020
    Swift1987, 14. August 2019
    #8
  9. @Excel121150

    Bitte schau auch mal im anderen Forum (Kommentar von Steve)
    Ich habe in einer Vorversion versucht, den Supplier Name als Suchkriterium zu integrieren, leider hat mir das Programm falsche Werte für Status und Prio übernommen.
     
    Swift1987, 14. August 2019
    #9
  10. Ich würde dir gerne auch meine Datei schicken, dann ist es glaub ich schneller verständlich, was getan werden soll.
    Hier kann ich sie nicht hochladen, da zu groß.

    Andere Möglichkeit?
    Mail?
     
    Swift1987, 14. August 2019
    #10
  11. Exl121150 Erfahrener User
    Hallo,
    ich konnte diesen Effekt reproduzieren - offenbar hast du im Arbeitsblatt "Project_Import" innerhalb der Liste der zu testenden Werte in Spalte B leere Zellen, was natürlich tödlich enden muss, denn das Makro findet im Arbeitsblatt "Overview" in Spalte A über 1 Million solcher Leerzellen und trägt dann in Spalte I die entsprechenden Werte aus Spalte K des Blattes "Project_Import" ein. Damit konnte ich nun wirklich nicht rechnen. Damit solche Unsinnigkeiten nicht wieder auftreten können, habe ich einen zusätzlichen Test auf Leerwert für die Variable "CelStatus" eingefügt.
    Soll das heißen, dass die FIND-Funktion bereits ab Zelle .Cells(4,1) = Overview!A4 suchen soll? Wenn dem so ist, muss die FIND-Funktion wie folgt lauten:
    Set rFoundStatus = .Columns("A").Find(What:=CelValueStatus, After:=.Cells(3, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
    denn die Suche der FIND-Funktion beginnt im Suchbereich (also Spalte A von Overview) in der ersten Zelle NACH (deshalb AFTER:=...) dieser Zelle. Findet die FIND/FINDNEXT-Funktion in den nachfolgenden Zellen des Suchbereichs nichts mehr, beginnt sie wieder in der ersten Zelle des Suchbereichs zu suchen, also in diesem Fall in Overview!$A$1 (und nicht wieder in $A$4)

    Um dies flexibel und im Makro überall konsistent handhaben zu können, habe ich eine zusätzliche Variable eingefügt und ihr den entsprechenden Wert zugewiesen
    HeaderRowNr = 3
    d.h. alle Zellen in den ersten 3 Zeilen von Blatt "Overview" gehören zum Kopfbereich. Und das Makro wurde so umgestellt, dass es in diesem Bereich nicht sucht, sondern die Suche erst in Zeile 4 (Overview!A4) beginnt und auch hinterdrein nicht wieder im Kopfbereich zu suchen beginnt.

    In der beiliegenden Excel-Datei ist eine Demoversion enthalten mit 2 Arbeitsblättern "Project_Import" und "Overview".
    Im allgemeinen Codemodul "Modul1" ist dein Makro in modifizierter Form enthalten.
     
    Exl121150, 15. August 2019
    #11
  12. Hallo Anton Exl,

    ich habe deinen Code entsprechend an meine Tabelle angepasst und es funktioniert sehr gut.
    Ja ich habe vergessen zu erwähnen, dass in "Project_Import" Leerzeilen und -zellen sind.
    Auch die HeaderRowNr hat sehr gut funktioniert.

    Sollten in den Makros weitere Änderungen gefordert werden, bzw. Probleme auftauchen die ich nicht gelöst bekomme, hoffe ich, dass ich mich nochmal melden kann... :)

    Vielen Dank für deine Hilfe!
     
    Swift1987, 19. August 2019
    #12
Thema:

VBA- Projektname aus Importdatei kopieren und in anderes Tabellenblatt einfügen

Die Seite wird geladen...
  1. VBA- Projektname aus Importdatei kopieren und in anderes Tabellenblatt einfügen - Similar Threads - VBA Projektname Importdatei

  2. VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.

    in Microsoft Excel Hilfe
    VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.: Hallo zusammen, Eine Tabelle mit 9 Worksheets, Datenblatt, Studien, Studie_1 ...Studie_7. Auf dem Deckblatt werden in Zelle B4-B10 die Namen der Studien eingetragen. Davon abhängig ob ein Name...
  3. VBA Zeilen kopieren mit Bedingung

    in Microsoft Excel Hilfe
    VBA Zeilen kopieren mit Bedingung: Hallo zusammen, Ich möchte per Makro Zeilen aus Tabelle2 in Tabelle3 kopieren, wenn eine Bedingung erfüllt ist. Bedingung: Der Wert in Spalte E (Tabelle2) kommt in Tabelle1 in Spalte E vor....
  4. VBA - Datensätze ans Ende einer anderen Tabelle kopieren

    in Microsoft Excel Hilfe
    VBA - Datensätze ans Ende einer anderen Tabelle kopieren: Hallo zusammen, ich habe gerade eine "Abrechnungs"-Datei für einen Kindergartenbasar erstellt. Es wäre klasse, wenn man per Schaltfläche die Datensätze aus der Tabelle "Kaeufer" ans Ende der...
  5. Laufzeitfehler 9 VBA

    in Microsoft Excel Hilfe
    Laufzeitfehler 9 VBA: Nschdem ich die Office Version von 2010 auf 2019 aktualisiert habe wird mir der Laufzeitfehler 9 ausgegeben. Das ist der Code Sub FiberCollect() Dim NumRows As Long 'letzte celle Dim Counter As...
  6. Excel VBA Spalten mit Ordnerinhalt vergleichen

    in Microsoft Excel Hilfe
    Excel VBA Spalten mit Ordnerinhalt vergleichen: Hallo, Bin ehr Excel VBA Neuling, Würde aber gerne in einer bestehender Tabelle die Auflistung der Ordner mit dem eigentlichen Stand in den besagten Ordner kontrollieren. Also in der Spalte Q10...
  7. VBA - letzte nicht-leere Spalte

    in Microsoft Excel Hilfe
    VBA - letzte nicht-leere Spalte: Moin, liebe VBA-Spezis, mit Cells(99, Columns.Count).End(xlToLeft).Column bestimme ich die Spaltenzahl der letzten benutzten Zelle in Zeile 99. Soweit, so klar. Nun habe ich aber Formeln in...
  8. Summieren farbiger Zahlen anhand des Farbcodes ohne VBA

    in Microsoft Excel Hilfe
    Summieren farbiger Zahlen anhand des Farbcodes ohne VBA: Hallo liebes Forum, welche Formel muss ich eingeben, wenn ich farbige Ziffern (z.B. rot = Farbcode 3; grün = 4) addieren möchte. Danke im voraus für die schnelle Antwort Gruß mfkathie
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden