Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
856to860
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
856to860
856to860
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten automatisiert aus eine Arbeitsmappe kopieren

Daten automatisiert aus eine Arbeitsmappe kopieren
26.03.2007 15:00:03
sascha76er
Hallo,
ich habe folgendes Problem:
Ich habe eine Excel-Datei mit verschiedenen Arbeitsmappen, daraus müssen Daten aus einer Arbeitsmappe in andere kopiert werden.
1. Ich möchte aus der Arbeitsmappe "Tabelle1" alle Zeilen in die Abeitsmappe "Strecke" (ab Zeile 2) kopieren, wenn in der Spalte "G" (Artikelnr.) das Wort "STRECKE" vorkommt.
2. Ich möchte aus der Arbeitsmappe "Tabelle1" alle Zeilen in die Arbeitsmappe "Fertigung" (ab Zeile 2) kopieren, wenn in der Spalte "G" (Artikelnr.) das Wort "FERT" oder "Rohrbieger" vorkommt.
3. Ich möchte aus der Arbeitsmappe "Tabelle1" alle Zeilen in die Arbeitsmappe "Verkauf" (ab Zeile 2) kopieren, wenn in der Spalte "G" (Artikelnr.) das Wort "STRECKE", "FERT", "Rohrbieger", "Fracht", "Nauthfracht", "KLM", "ABNH", "HVP" und "HVB" auftaucht.
Zusätzlich dürfen keine Zeilen aus der "Tabelle1" übernommen werden in denen in der Spalte "G" (Kundenname) die Wörter "Außenlager Ecker", "UMBUCHUNG" oder "Bestandskorrektur" auftauchen.
4. In der Arbeitsmappe "Verkauf" müssen bei den Artikeln "Eloxal", "Pulver", "Verpackung", "Mindestlack", "Delwoschliff", "PROFILANSCHNITTEKG", "PROFILANSCHNITTEM", "BLECHANSCHNITTEKG" und "BLECHANSCHNITTEST" die Spalte "N" mit dem Faktor 0,2 multipliziert werden. Zusätzlich muss bei diesen Artikeln in der Spalte "K" (HASP%) der Wert 20,00 eingetragen werden.
Hier mein Beispiel: https://www.herber.de/bbs/user/41398.zip
Ich hab keine Idee wie ich das lösen soll, da ich das jeden machen muss würde mir jegliche Art einer Automatisierung sehr weiter helfen.
Hat hier jemand eine Idee wie ich das Problem lösen kann, bin für jeden Lösungsvorschlag sehr dankbar.
Gruß
Sascha

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten automatisiert aus eine Arbeitsmappe kopieren
26.03.2007 15:58:33
geri
Hallo

Sub dat_ZielA()
Dim ByI As Integer
Dim InSpalte As Integer
Dim LoZeile As Integer
Sheets("Ziel").Select 'lösche Ziel Inhalt
Rows("8:2000").Select
Selection.ClearContents
Range("A8").Select
Sheets("All").Select
LoZeile = 8
InSpalte = 1
With Worksheets("All")' von Blatt
For ByI = 8 To 6000
If .Cells(ByI, 7) = "Begriff" Then 'in Spalte 7 steht Begriff welche Copy soll
.Range(Cells(ByI, 1), Cells(ByI, 16)).Copy _
Destination:=Worksheets("Ziel").Cells(LoZeile, InSpalte)
LoZeile = LoZeile + 1
End If
Next ByI
End With
Sheets("All").Select
End Sub
versuch mal copiere dies mehrmals und passe die Begriffe und Ziel an
gruss geri
Anzeige
AW: Daten automatisiert aus eine Arbeitsmappe kopieren
26.03.2007 16:02:23
sascha76er
Hallo Geri,
vorab vielen Dank für Deine schnelle Antwort, allerdings habe ich keine VBA-Kenntnisse!
Wo muss ich Deine Antwort hinkopieren und editieren?
Gruß
Sascha
AW: Daten automatisiert aus eine Arbeitsmappe kopieren
26.03.2007 16:09:04
sascha76er
Hallo Geri,
oder könntest Du vielleicht das mal exemplarisch in meiner Excel-Datei hinterlegen und uploaden. Tut mir wirklich leid, dass ich Dich so nerven muss.
Gruß
Sascha
AW: Daten automatisiert aus eine Arbeitsmappe kopi
26.03.2007 18:33:37
fcs
Hallo Sascha,
ich hab mir dein Problem auch mal vorgenommen. Den nachfolgenden Code kopierst du im VBA-Editor in ein Modul der Datei, das du zusätzlich einfügst. Das Makro überträgt nur die Werte aus der Tabelle1 in die entsprechenden anderen Tabellen. Kopieren der Zellen/Zeilen mit den Formeln führt Fehlern, da sich die Bezüge zu den Zellen in der Tabelle "Export" ändern.
Mir ist aufgefallen, dass die von dir unter 4. beschriebenen Bedingungen garnicht zum Tragen kommen, weil entsprechenden Datenzeilen auf Grund der Bedingungen unter 3. garnicht in die Tabelle "Verkauf" übertragen werden.
Gruß
Franz
Public wks1 As Worksheet, wksVerkauf As Worksheet, wksFertig As Worksheet, wksStrecke As  _
Worksheet
Public Z1 As Long, Z1max As Long, ZVerk As Long, ZFertig As Long, ZStrecke As Long
Public ArtikelNr As String
Sub Tabelle1_auswerten()
'Übertragung von Daten aus Tabelle1 in die Tabellen Verkauf, Fertigung und Strecke
Set wks1 = Worksheets("Tabelle1")
Set wksVerkauf = Worksheets("Verkauf")
Set wksFertig = Worksheets("Fertigung")
Set wksStrecke = Worksheets("Strecke")
'vorhandene Altdaten in den Tabellen löschen
With wksVerkauf
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 8)).ClearContents
End If
End With
With wksFertig
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 8)).ClearContents
End If
End With
With wksStrecke
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 8)).ClearContents
End If
End With
'Startzeilen in den Tabellen setzen
ZVerk = 2
ZFertig = 2
ZStrecke = 2
With wks1
Z1 = 2 '1.Zeile mit Daten in Tabelle1
'letzte Zeile mit Daten 0 in Tabelle1, Spalte 2
Z1max = .Cells(.Rows.Count, 1).End(xlUp).Row
Do Until .Cells(Z1max, 2).Value  0
Z1max = Z1max - 1
Loop
For Z1 = Z1 To Z1max
'Prüfen der ArtikelNr in Spalte G und ggf. Daten übertragen in eine der Tabellen
ArtikelNr = UCase(.Cells(Z1, 7).Value)
If ArtikelNr Like "*STRECKE*" Then
Call NachStrecke
Call NachVerkauf
End If
If ArtikelNr Like "*FERT*" Or ArtikelNr Like "*ROHRBIEGER*" Then
Call NachFertigung
Call NachVerkauf
End If
If ArtikelNr Like "*FRACHT*" Or ArtikelNr Like "*NAUTHFRACHT*" _
Or ArtikelNr Like "*KLM*" Or ArtikelNr Like "*ABNH*" _
Or ArtikelNr Like "*HVP*" Or ArtikelNr Like "*HVB*" Then
Select Case UCase(.Cells(Z1, 6).Value) 'Kundenname
Case "AUßENLAGER ECKER", "UMBUCHUNG", "BESTANDSKORREKTUR"
'do nothing, es sollen keine Daten übertragen werden
Case Else
Call NachVerkauf
End Select
End If
Next
End With
End Sub
Private Sub NachStrecke()
'Daten nach Tabelle Strecke übertragen
With wksStrecke
.Cells(ZStrecke, 1).Range("A1:J1").Value = wks1.Cells(Z1, 5).Range("A1:J1").Value
End With
ZStrecke = ZStrecke + 1 'Zeilenzähler erhöhen
End Sub
Private Sub NachFertigung()
'Daten nach Tabelle Fertigung übertragen
With wksFertig
.Cells(ZFertig, 1).Range("A1:J1").Value = wks1.Cells(Z1, 5).Range("A1:J1").Value
End With
ZFertig = ZFertig + 1 'Zeilenzähler erhöhen
End Sub
Private Sub NachVerkauf()
'Daten nach Tabelle Verkauf übertragen
With wksVerkauf
'Zellinhalte aus Tabelle1 nach Tabelle Verkauf übertragen
.Cells(ZVerk, 1).Range("A1:J1").Value = wks1.Cells(Z1, 5).Range("A1:J1").Value
If ArtikelNr Like "*ELOXAL*" Or ArtikelNr Like "*PULVER*" _
Or ArtikelNr Like "*VERPACKUNG*" Or ArtikelNr Like "*MINDESTLACK*" _
Or ArtikelNr Like "*DELWOSCHLIFF*" Or ArtikelNr Like "*PROFILANSCHNITTEKG*" _
Or ArtikelNr Like "*PROFILANSCHNITTEM*" Or ArtikelNr Like "*BLECHANSCHNITTEKG*" _
Or ArtikelNr Like "*BLECHANSCHNITTEST*" Then
'Wert in Spalte J (RE in EUR) mit 0,2 multiplizieren
.Cells(ZVerk, 10).Value = .Cells(ZVerk, 10).Value * 0.2
'Wert in Spalte G (HASP%) auf 20 setzen
.Cells(ZVerk, 7).Value = 20#
End If
End With
ZVerk = ZVerk + 1 'Zeilenzähler erhöhen
End Sub

Anzeige
AW: Daten automatisiert aus eine Arbeitsmappe kopi
27.03.2007 08:08:31
sascha76er
Hallo Franz,
leider bin ich jetzt gerade erst dazu gekommen mir Deine Antwort anzugucken, vorab muss ich sagen vielen Dank für das tolle Skript es wird mir wohl in der Zukunft viel Zeit einsparen.
Du hast recht, die unter 3. beschriebene Bedingung müsste wie folgt lauten:
3. Ich möchte aus der Arbeitsmappe "Tabelle1" alle Zeilen in die Arbeitsmappe "Verkauf" (ab Zeile 2) kopieren, wenn in der Spalte "G" (Artikelnr.) das Wort "STRECKE", "FERT", "Rohrbieger", "Fracht", "Nauthfracht", "KLM", "ABNH", "HVP" und "HVB" nicht auftaucht.
Zusätzlich dürfen keine Zeilen aus der "Tabelle1" übernommen werden in denen in der Spalte "G" (Kundenname) die Wörter "Außenlager Ecker", "UMBUCHUNG" oder "Bestandskorrektur" auftauchen.
Meinst Du, Du könntest mir das Skript nochmals anpassen und die Bedingung 4. auch einfügen?
Gibt es eigentlich gut Lektüre über den VBA-Editor?
Vielen Dank
Sascha
Anzeige
AW: Daten automatisiert aus eine Arbeitsmappe kopi
27.03.2007 14:05:10
fcs
Hallo Sascha,
ich hab das Skript an die veränderten Prüfbedingungen für die ArtikelNr angepasst.
Den Code für die Bedingungen unter 4. hatte ich schon in den Code eingearbeitet.
Ein ist mir noch aufgefallen: Für ArtikelNr "MINDESTLACK" soll eine Sonderberechnung erfolgen.
In der Tabelle hab ich nur ArtikelNr "MINDESTR.LACK" gefunden.
Hier muss du ggf. die Prozedur "Private Sub NachVerkauf()" noch entsprechend anpassen.
Gruß
Franz
Public wks1 As Worksheet, wksVerkauf As Worksheet, wksFertig As Worksheet, wksStrecke As  _
Worksheet
Public Z1 As Long, Z1max As Long, ZVerk As Long, ZFertig As Long, ZStrecke As Long
Public ArtikelNr As String
Sub Tabelle1_auswerten()
'Übertragung von Daten aus Tabelle1 in die Tabellen Verkauf, Fertigung und Strecke
Set wks1 = Worksheets("Tabelle1")
Set wksVerkauf = Worksheets("Verkauf")
Set wksFertig = Worksheets("Fertigung")
Set wksStrecke = Worksheets("Strecke")
'vorhandene Altdaten in den Tabellen löschen
With wksVerkauf
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 10)).ClearContents
End If
End With
With wksFertig
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 10)).ClearContents
End If
End With
With wksStrecke
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 10)).ClearContents
End If
End With
'Startzeilen in den Tabellen setzen
ZVerk = 2
ZFertig = 2
ZStrecke = 2
With wks1
Z1 = 2 '1.Zeile mit Daten in Tabelle1
'letzte Zeile mit Daten 0 in Tabelle1, Spalte 2
Z1max = .Cells(.Rows.Count, 1).End(xlUp).Row
Do Until .Cells(Z1max, 2).Value  0
Z1max = Z1max - 1
Loop
For Z1 = Z1 To Z1max
'Prüfen der ArtikelNr in Spalte G und ggf. Daten übertragen in eine der Tabellen
ArtikelNr = UCase(.Cells(Z1, 7).Value)
' In der If und den ElseIf-Zeilen werden alle ArtikelNr abgefragt, die nicht_
' in Tabelle Verkauf übertragen werden sollen
If ArtikelNr Like "*STRECKE*" Then
Call NachStrecke
ElseIf ArtikelNr Like "*FERT*" Or ArtikelNr Like "*ROHRBIEGER*" Then
Call NachFertigung
ElseIf ArtikelNr Like "*FRACHT*" Or ArtikelNr Like "*NAUTHFRACHT*" _
Or ArtikelNr Like "KLM*" Or ArtikelNr Like "ABNH*" _
Or ArtikelNr Like "HVP*" Or ArtikelNr Like "HVB*" Then
'do nothing, bei diesen Werten sollen keine Übertragungen erfolgen
Else
'Übertragung nach Tabelle Verkauf außer Sonderwerte
Select Case UCase(.Cells(Z1, 6).Value) 'Kundenname
Case "AUßENLAGER ECKER", "UMBUCHUNG", "BESTANDSKORREKTUR"
'do nothing, es sollen keine Daten übertragen werden
Case Else
Call NachVerkauf
End Select
End If
Next
End With
End Sub
Private Sub NachStrecke()
'Daten nach Tabelle Strecke übertragen
With wksStrecke
.Cells(ZStrecke, 1).Range("A1:J1").Value = wks1.Cells(Z1, 5).Range("A1:J1").Value
End With
ZStrecke = ZStrecke + 1 'Zeilenzähler erhöhen
End Sub
Private Sub NachFertigung()
'Daten nach Tabelle Fertigung übertragen
With wksFertig
.Cells(ZFertig, 1).Range("A1:J1").Value = wks1.Cells(Z1, 5).Range("A1:J1").Value
End With
ZFertig = ZFertig + 1 'Zeilenzähler erhöhen
End Sub
Private Sub NachVerkauf()
'Daten nach Tabelle Verkauf übertragen
With wksVerkauf
'Zellinhalte aus Tabelle1 nach Tabelle Verkauf übertragen
.Cells(ZVerk, 1).Range("A1:J1").Value = wks1.Cells(Z1, 5).Range("A1:J1").Value
'Artikelnummern bei denen zusätzlich Werte geändert werden sollen
If ArtikelNr Like "*ELOXAL*" Or ArtikelNr Like "*PULVER*" _
Or ArtikelNr Like "*VERPACKUNG*" Or ArtikelNr Like "*MINDESTLACK*" _
Or ArtikelNr Like "*DELWOSCHLIFF*" Or ArtikelNr Like "*PROFILANSCHNITTEKG*" _
Or ArtikelNr Like "*PROFILANSCHNITTEM*" Or ArtikelNr Like "*BLECHANSCHNITTEKG*" _
Or ArtikelNr Like "*BLECHANSCHNITTEST*" Then
'Wert in Spalte J (RE in EUR) mit 0,2 multiplizieren
.Cells(ZVerk, 10).Value = .Cells(ZVerk, 10).Value * 0.2
'Wert in Spalte G (HASP%) auf 20 setzen
.Cells(ZVerk, 7).Value = 20#
End If
End With
ZVerk = ZVerk + 1 'Zeilenzähler erhöhen
End Sub

Anzeige
AW: Daten automatisiert aus eine Arbeitsmappe kopi
27.03.2007 15:46:00
sascha76er
Hallo Franz,
vielen Dank für die Änderung, funktioniert alles einwandfrei.
Allerdings wollte ich Dein Skript gerade noch erweitern, leider ohne Erfolg.
Ich wollte an dieser Stelle noch zwei Kundennamen ("Konsi - Lager-Fertigung" und "Lager Klarenthal")einpflegen welche nicht in die Tabelle Verkauf übertragen werden sollen. -leider ohne Erfolg
So habe ich es gemacht:
________________________________________________________________________
Else
'Übertragung nach Tabelle Verkauf außer Sonderwerte
Select Case UCase(.Cells(Z1, 6).Value) 'Kundenname
Case "AUßENLAGER ECKER", "UMBUCHUNG", "BESTANDSKORREKTUR", "Konsi - Lager-Fertigung", "Lager Klarenthal"
'do nothing, es sollen keine Daten übertragen werden
Case Else
Call NachVerkauf
_________________________________________________________________________
Was muss ich in Deinem Skript abändern, damit bei Bedarf auch die Spalten A bis D aus der Tabelle1 in die anderen kopiert werden?
Gruß
Sascha
Anzeige
AW: Daten automatisiert aus eine Arbeitsmappe kopi
27.03.2007 18:36:25
fcs
Hallo Sascha,
du muss die Texte in der Case-Anweisung alle in Grossbuchstaben Schreiben.
Mit der UCase-Funktion in der Select Case-Zeile wird der Zellinhalt für die Prüfung in Großbuchstaben umgewandelt.
Dies hatte ich so gemacht, damit man sich bei der Angabe der zu prüfendne Texte nicht um Groß-/Kleinschreibung kümmern muss.
Übertragen weiterer Spalten aus der Tabelle1:
Hierzu muss du entsprechende Anpassungen in den 3 Prozeduren NachStrecke, NachFertigung NachVerkauf machen.
Gruß
Franz
Private Sub NachStrecke()
'Daten nach Tabelle Strecke übertragen
With wksStrecke
.Cells(ZStrecke, 1).Range("A1:N1").Value = wks1.Cells(Z1, 1).Range("A1:N1").Value
End With
ZStrecke = ZStrecke + 1 'Zeilenzähler erhöhen
End Sub
Private Sub NachFertigung()
'Daten nach Tabelle Fertigung übertragen
With wksFertig
.Cells(ZFertig, 1).Range("A1:N1").Value = wks1.Cells(Z1, 1).Range("A1:N1").Value
End With
ZFertig = ZFertig + 1 'Zeilenzähler erhöhen
End Sub
Private Sub NachVerkauf()
'Daten nach Tabelle Verkauf übertragen
With wksVerkauf
'Zellinhalte aus Tabelle1 nach Tabelle Verkauf übertragen
.Cells(ZVerk, 1).Range("A1:N1").Value = wks1.Cells(Z1, 1).Range("A1:N1").Value
'Artikelnummern bei denen zusätzlich Werte geändert werden sollen
If ArtikelNr Like "*ELOXAL*" Or ArtikelNr Like "*PULVER*" _
Or ArtikelNr Like "*VERPACKUNG*" Or ArtikelNr Like "*MINDESTLACK*" _
Or ArtikelNr Like "*DELWOSCHLIFF*" Or ArtikelNr Like "*PROFILANSCHNITTEKG*" _
Or ArtikelNr Like "*PROFILANSCHNITTEM*" Or ArtikelNr Like "*BLECHANSCHNITTEKG*" _
Or ArtikelNr Like "*BLECHANSCHNITTEST*" Then
'Wert in Spalte N (RE in EUR) mit 0,2 multiplizieren
.Cells(ZVerk, 14).Value = .Cells(ZVerk, 14).Value * 0.2
'Wert in Spalte K (HASP%) auf 20 setzen
.Cells(ZVerk, 11).Value = 20#
End If
End With
ZVerk = ZVerk + 1 'Zeilenzähler erhöhen
End Sub

Anzeige
AW: Daten automatisiert aus eine Arbeitsmappe kopi
29.03.2007 09:53:00
sascha76er
Hallo Franz,
vielen Dank für Deine super Unterstützung. Das Skript funktioniert nun einwandfrei, es wird mir in der Zukunft viel Arbeit ersparen.
Gruß
Sascha

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige