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
Hallo Frank,
lade doch bitte stark gekürzt, aber wie soll prinzipell geschehen, Deine Sheets hoch.
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
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.
Hallöchen,
fehlt da nicht die Bedingung, dass
Zitat:alle Mitarbeiter aus der Arbeitsmappe "C:\Firma\Personal.xlsm" welche in Spalte B "Verkauf" stehen haben
übertragen werden.
?
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