Herbers Excel/VBA-Archiv

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

Daten Suchen und Kopieren

• Daten Suchen und Kopieren von B Knoop vom 23.10.2014 10:07:19
• AW: Daten Suchen und Kopieren - von Tino am 23.10.2014 12:12:19
  • AW: Daten Suchen und Kopieren - von B Knoop am 23.10.2014 13:42:58
    • AW: Daten Suchen und Kopieren - von Tino am 23.10.2014 14:51:53
      • AW: Daten Suchen und Kopieren - von B Knoop am 23.10.2014 15:53:17
• With Tabelle1 --> With sheets("Tabelle1") o.T. - von MCO am 23.10.2014 12:13:42

Betrifft: Daten Suchen und Kopieren von: B Knoop
Geschrieben am: 23.10.2014 10:07:19

Hallo,

ich habe versucht ein Makro zuschreiben, welches aus der geöffneten Datei eine Projektnamen Zeile "A1" ausliest, anschließend eine weitere Exceldatei öffnet, in dieser in Spalte "G" nach dem Projektnamen sucht und anschließend die betreffende Zeile von der geöffneten Seite auswählt und in die zu anfangs erstellte Datei kopiert (am besten nur Werte). Dabei ist es möglich, dass der Projektname mehrmals in der Quelldatei vorkommt, in dem Fall sollen alle Treffer kopiert werden.
Leider funktioniert das Makro nicht, kann mir jemand helfen?
Vielen Dank im Vorraus.

Sub Kopieren()
Dim Zeile As Long
Dim ZeileMax As Long
Dim i As Long
Dim ZielWb As Workbook
Set ZielWb = ThisWorkbook

Projekt = Range("A1").Value

Workbooks.Open ("R:\Allgemein\Rein\Reinklein2014.xlsx")
With Tabelle1
ZeileMax = .UsedRange.Rows.Count
n = 1

For Zeile = 2 To ZeileMax

If .Cells(Zeile, 7).Value = Projekt Then

.Rows(Zeile).Copy Destination:=ZielWb(Tabelle1).Rows(n)
n = n + 1

ZielWb.Activate

Workbooks("R:\Allgemein\Rein\Reinklein2014.xlsx").Close savechanges:=False

End If
Next Zeile
End With
End Sub

Betrifft: AW: Daten Suchen und Kopieren von: Tino
Geschrieben am: 23.10.2014 12:12:19

Hallo,
kannst mal so testen!
Im Code die entsprechenden Daten anpassen.

Sub Kopieren()
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
Dim Projekt
Dim Quell As Workbook, QuellSheet As Worksheet, rngQuelle As Range

On Error GoTo ErrorHandler:
Application.ScreenUpdating = False
Application.EnableEvents = False

'Projekt suche, Tabelle und Zelle anpassen
Projekt = Tabelle2.Range("A1").Value
'einfügen ab Zeile
n = 1

'Pfad Datei anpassen
Set Quell = Workbooks.Open("R:\Allgemein\Rein\Reinklein2014.xlsx")
'Tabelle Quelle anpassen
Set QuellSheet = Quell.Sheets("Tabelle1")

With Tabelle1 'Zieltabelle anpassen
    ZeileMax = QuellSheet.UsedRange.Rows.Count
    
    For Zeile = 2 To ZeileMax
        If QuellSheet.Cells(Zeile, 7).Value = Projekt Then
            If Not rngQuelle Is Nothing Then
                Set rngQuelle = Union(rngQuelle, QuellSheet.Rows(Zeile))
            Else
                Set rngQuelle = QuellSheet.Rows(Zeile)
            End If
        End If

    Next Zeile
    
    If Not rngQuelle Is Nothing Then
        ''evtl. alte Daten löschen ************
        '.Rows(n).Resize(.Rows.Count - n + 1).Clear
        rngQuelle.Copy
        .Rows(n).PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
    End If
    
    
End With
ErrorHandler:

If Not Quell Is Nothing Then Quell.Close savechanges:=False

Application.EnableEvents = True
Application.ScreenUpdating = True

If Err.Number <> 0 Then
    MsgBox Err.Description, _
           vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
           "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub

Gruß Tino

Betrifft: AW: Daten Suchen und Kopieren von: B Knoop
Geschrieben am: 23.10.2014 13:42:58

Super, das klappt vielen Dank für deine Hilfe :)
Ich habe nur eine Verständnisfrage was genau macht:

If Not rngQuelle Is Nothing Then
Set rngQuelle = Union(rngQuelle, QuellSheet.Rows(Zeile))
Else
Set rngQuelle = QuellSheet.Rows(Zeile)

Betrifft: AW: Daten Suchen und Kopieren von: Tino
Geschrieben am: 23.10.2014 14:51:53

Hallo,
diese Zeilen fassen die gefundenen Datenbereiche zusammen.
Um eine Union zu bilden, muss die Variable "rngQuelle" mindestens aus einen Zelleberich bestehen.

Daher wenn diese noch keinen Bereich hat, wird zuerst mal einer zugewiesen.

Set rngQuelle = QuellSheet.Rows(Zeile)

Danach kann man mit Union den Bereits vorhandenen und den neuen vereinigen.

Set rngQuelle = Union(rngQuelle, QuellSheet.Rows(Zeile))

Aus der Hilfe "Union-Methode"
Gibt die Vereinigung von mindestens zwei Bereichen zurück.

Gruß Tino

Betrifft: AW: Daten Suchen und Kopieren von: B Knoop
Geschrieben am: 23.10.2014 15:53:17

Super, vielen Dank für die Erklärung :)

Betrifft: With Tabelle1 --> With sheets("Tabelle1") o.T. von: MCO
Geschrieben am: 23.10.2014 12:13:42

Gruß, MCO

Beiträge aus den Excel-Beispielen zum Thema "Daten Suchen und Kopieren"