Daten aus einer anderen geöffneten Arbeitsmappe einlesen?

[FrankyHB]

Hallo, vielleicht kann mir jemand weiterhelfen.

Im Verzeichnis habe ich eine Arbeitsmappe "C:\Firma\Personal.xlsm" = Quelle
im Tabellenblatt "Mitarbeiter" sind in Spalte A die Mitarbeiter und in Spalte B die Abteilungen aufgelistet.

Im selben Verzeichnis habe ich die Arbeitsmappe "C:\Firma\Abrechnungen.xlsm" = Ziel

Die Arbeitsmappe "C:\Firma\Personal.xlsm" ist immer geöffnet.

Ich möchte nun, dass wenn ich die Datei "C:\Firma\Abrechnungen.xlsm" öffne, im dortigen Arbeitsblatt, welches ebenfalls den
Namen "Mitarbeiter" trägt, alle Mitarbeiter aus der Arbeitsmappe "C:\Firma\Personal.xlsm" welche in Spalte B "Verkauf" stehen haben
übertragen werden.

Kann mir jemand helfen?

Gruß Frank

[EbyAS]

Hallo Frank,
lade doch bitte stark gekürzt, aber wie soll prinzipell geschehen, Deine Sheets hoch.

[schauan]

Hallo Frank,

aus Deinen Dateinamen entnehme ich, dass Du bereits mit Makros arbeitest. Du könntest Dir in dem Fall die Aktion aufzeichnen, im Prinzip - Datei und Blatt wechseln, nach Verkauf filtern, kopieren, zurück wechseln, Blatt und Zelle auswählen, Einfügen. Siehe dazu auch die Anleitung zur Makroaufzeichnung

Excel-Word-Makrorekorder

[Gast 123]

Hallo

ich hoffe mein Code laeuft auch ohne Beispieldatei. Es sind zwei verschieden Makros. Das erste kopiert die ganze Spalte B aus Personal in Spalte B Mitarbeiter. Das zweite ist eine For Next Schleife, falls leere Zeilen aus Personal nicht mit kopiert werden sollen. Sollte die Zielspalte eine andere sein im Makro bitte aendern.

mfg Gast 123

Code:

Option Explicit
'Personal.xlsm = Quelle
'Abrechnungen.xlsm = Ziel


Sub Personaldaten_Spalte_übertragen()
Dim WBk As Workbook, lz1 As Long
Dim PSht As Worksheet, lz2 As Long
Set WBk = Worksheets("Personal.xlsm")
Set PSht = WBk.Worksheets("Mitarbeiter")
   
With ThisWorkbook.Worksheets("Mitarbeiter")
     lz1 = .UsedRange.Rows.Count  'Mitarbeiter Range
     lz2 = PSht.Cells(Rows.Count, 2).End(xlUp).Row
   
    'alten Daten ,n Mitarbeiter Tabelle löschen!
    .Range("B2:B" & lz1).ClearContents
   
     'Daten in Personal kopieren und Mitarbeiter einfügen
     PSht.Range("B2:B" & lz2).Copy  '1:1 Kopie wie Personal
     .Range("B2").PasteSpecial xlPasteValues   '** Spalte ggf aendern!
     Application.CutCopyMode = False
End With
End Sub



Sub Personaldaten_Zeile_übertragen()
Dim AC As Range, Zeile As Long
Dim WBk As Workbook, lz1 As Long
Dim PSht As Worksheet, lz2 As Long
Set WBk = Worksheets("Personal.xlsm")
Set PSht = WBk.Worksheets("Mitarbeiter")
   
With ThisWorkbook.Worksheets("Mitarbeiter")
     lz1 = .UsedRange.Rows.Count  'Mitarbeiter Range
     lz2 = PSht.Cells(Rows.Count, 2).End(xlUp).Row
   
    'alten Daten ,n Mitarbeiter Tabelle löschen!
    .Range("B2:B" & lz1).ClearContents
     Zeile = 2   '1. Zeile zum kopieren
   
     'Daten über For Next Schleife einfügen
     For Each AC In PSht.Range("B2:B" & lz2)
        If AC.Value <> "" Then
          .Cells(Zeile, "B") = AC.Value   '** Spalte in Zells ggf aendern!
           Zeile = Zeile + 1
        End If
     Next AC
     Application.CutCopyMode = False
End With
End Sub

---

Nachtrag:   Alternativ kann man auch die Daten per Formel aus der Tabelle Personal holen.

[schauan]

Hallöchen,

fehlt da nicht die Bedingung, dass

alle Mitarbeiter aus der Arbeitsmappe "C:\Firma\Personal.xlsm" welche in Spalte B "Verkauf" stehen haben
übertragen werden.

?

[FrankyHB]

Hallo, vielen Dank für eure Hilfe,

ich habe das Problem wie folgt gelöst:


Sub Mitarbeiter()

Dim i As Long, tLR As Long
Dim ZielWks As Worksheet
Dim QuelleWks As Worksheet

Set QuelleWks = Workbooks("Personal.xlsm").Worksheets("Mitarbeiter")

Set ZielWks = Workbooks("Abrechnung.xlsm").Worksheets("Mitarbeiter_Abfrage")

Worksheets("Mitarbeiter_Abfrage").Rows("2:" & Worksheets("Mitarbeiter_Abfrage").Rows.Count).ClearContents

With QuelleWks
    For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
 
        If .Cells(i, 2).Value = "Verkauf" Then
            tLR = ZielWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Debug.Print tLR
            With ZielWks
            .Range(.Cells(tLR, 1), .Cells(tLR, 2)).Value = QuelleWks.Range(QuelleWks.Cells(i, 1), _
QuelleWks.Cells(i, 2)).Value
            End With
        End If
    Next i
End With

End Sub


Gruß Frank