Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
920to924
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
920to924
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

kpopieren und eifügen

kpopieren und eifügen
31.10.2007 10:36:50
volker
Hai Leute,
ich hab ein grosses Problem, welches ich hier mal zrstückelt darlege, dann bekomm ich es selbst evtl. hin.
Ich möchte aus der Tabelle X ab der 4. Zeile (die ersten 4 Zeilen sind Überschriften) alle beschriebenen Zeilen kopieren und in mein aktuelles sheet einfügen.
Wie sieht denn so ein makro aus?
Danke Gruss volker

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: kpopieren und eifügen
31.10.2007 14:21:43
Chris
Servus,
kommt ganz drauf an.
Gibt es z.B.: Leerzeilen oder Leerzellen, oder ist ein bestimmter Range befüllt?
Erklär mal, mit welchem Prüfkriterium, z.B. Spalte A oder Sonstiges, da geprüft werden soll.
Gruß
Chris

AW: kpopieren und eifügen
31.10.2007 15:32:28
volker
Hai Chris, Danke für Deine anteilnahme
folgendermaßen:
Die Referenz ist die Spalte A, sobald da eine Zelle kommt die leer ist, wars das. (die Bereiche können schon unterschiedlich gross sein, jedoch gehts immer ab Zeile 5 los so lange bis eben in Spalte A nichts mehr steht.
Mein momentaner Code, der bisher "nur" eine feste Zeile kopiert.
Viele Grüsse volker

Sub Zeileneinlesen()
Dim oFS As Object, oFLDR As Object, oFILE As Object
Dim lRow As Long
Dim wkbMy As Workbook, wsMy As Worksheet, lngZeile As Long, lngLetzte As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFS = CreateObject("scripting.filesystemobject")
lRow = 2
Set oFLDR = oFS.getfolder("\\Server04\av\SharePoint_Beschlaglisten")
For Each oFILE In oFLDR.Files
If oFILE Like "*.xls" Or oFILE Like "*.xlsm" Then
lRow = lRow
Set wkbMy = Workbooks.Open(oFILE)
For Each wsMy In wkbMy.Worksheets
If wsMy.Name Like "BL_*" Then
wsMy.Rows(5).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lRow = lRow + 1
End If
Next
wkbMy.Close False
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Anzeige
AW: kpopieren und eifügen
31.10.2007 18:29:00
Chris
Servus,
dann probiers mal so (ungetestet):

Sub Zeileneinlesen()
Dim oFS As Object, oFLDR As Object, oFILE As Object
Dim lRow As Long
Dim wkbMy As Workbook, wsMy As Worksheet, lngZeile As Long, lngLetzte As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFS = CreateObject("scripting.filesystemobject")
lRow = 2
Set oFLDR = oFS.getfolder("\\Server04\av\SharePoint_Beschlaglisten")
For Each oFILE In oFLDR.Files
If oFILE Like "*.xls" Or oFILE Like "*.xlsm" Then
lRow = lRow
Set wkbMy = Workbooks.Open(oFILE)
For Each wsMy In wkbMy.Worksheets
If wsMy.Name Like "BL_*" Then
Dim wsMyZeile As Long, wsMyletzte As Long
wsMyletzte = wsMy.Cells(Rows.Count, 1).End(xlUp).Row
For wsMyZeile = 5 To wsMyletzte
If wsMy.Cells(wsMyZeile, 1)  "" Then
wsMy.Cells(wsMyZeile, 1).EntireRow.Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:= _
False
lRow = lRow + 1
End if
Next wsMyZeile
End If
Next
wkbMy.Close False
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Gruß
Chris

Anzeige
AW: kpopieren und eifügen
02.11.2007 07:11:00
volker
Hallo Chris,
Super das funzt!
Kannst Du mir noch was helfen?
Warum kann ich die Einfüge Spalte nicht verschieben? (Zellbereich kleiner als kopierter....)
Ich möchte den Block ab Spalte 5 einfügen ("E").
Nun noch was ganz anderes:
Ich bin nun fast am Ende., jedoch soll das makro noch was machen.
Hast Du noch Lust und Laune? Ich erklärs mal.
Dem Bereich der Quelldatei steht ein Kopftext über. In diesem sind allgemeine Daten die ich in jede Zeile der Zieldatei mitgeben möchte.
(Auftrags#;Kommission;Modell;Kunde;nun der kopierte Bereich;Termin;Sachbearbeiter)
Ich lad mal eine Mappe hoch (mit dem makro von Dir) bei der, nur zur Übersichtlichkeit, beide Tabellen in einem Workbook sind.
https://www.herber.de/bbs/user/47341.xlsm
Vielen vielen Dank!
Grusse aus dem Feiertagverwöhnten Baden-Wür.
Volker

Anzeige
AW: kpopieren und eifügen
02.11.2007 08:51:25
Chris
Sorry Volker,
die Datei ist mit meinem Office nicht kompatibel. Ich hab kein OFfice 2007. Wenn ich da reinschauen soll, lad die Datei als .xls oder.xlm hoch.
Gruß
Chris

AW: kpopieren und eifügen
02.11.2007 11:18:28
volker
Hai Chris,
Ei da hab ich geschlafen.
nun als xls

Die Datei https://www.herber.de/bbs/user/47344.xls wurde aus Datenschutzgründen gelöscht


Vielen Dank und schönen TAg Grüsse volker

AW: kpopieren und eifügen
02.11.2007 11:58:28
Chris
Servus Volker,
zu 1 :
das Einfügen ab spalte 5 geht nicht, weil du die ganze Zeile kopierst (1:256 = EntireRow), somit passen beim Einfügen die Range-Größen nicht (bei Spalte 5 = 256 -5 = 251 Spalten Platz, aber es sollen 256 Spalten eingefügt werden, ergo läuft das Ganze in einen Fehler).
Das kann man umgehen, wenn man eine max Spaltenzahl kennt und dann nur den Range kopiert, wobei die Max-spaltenzahl =< = 251= sein muss.
zu 2:
Wie schauen die Daten aus der Quelldatei im Kopf (ich geh mal von Zeile1 -5 aus) aus und in welcher Art sollen diese mitgegeben werden.
Gruß
Chris

Anzeige
AW: kpopieren und eifügen
02.11.2007 13:06:08
volker
Hai Chris,
das klingt gut!
Die Daten sind die aus dem Sheet 2 "BL_Cerec" dies ist eine Bsp. Liste.
D.h. der Bereich (Range) könnte eingegrenzt werden. Momentan ist bis Spalte "L" beschrieben hier könnte man vielleicht noch 2 Spalten mehr, als Reserve, in den Bereich mit einbringen.
Die Kopfdaten sind (Auftrags#;Kommission;Modell;Kunde;Termin und Sachbearbeiter)
diese Daten hab ich alle mit Kommentar versehen (in der Bsp. Mappe)
In der Zieltabelle sollen all diese Daten für den jeweiligen Artikel in einer Zeile stehen (siehe Spaltenüberschrift).
Weitere Listen sollen einfach angehängt werden (was ja schon passt!)
Ich finds wirklich super dass Du mir hilftst!! DANKE Gruss volker

Anzeige
AW: kpopieren und eifügen
02.11.2007 14:51:58
Chris
Servus,
zu 1:
wsMy.Cells(wsMyZeile, 1).EntireRow.Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:= False
Diese Zeilen ändern in:
wsMy.Range("A" & wsMyZeile & ":N" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:= False
Hier jetzt Range(A-N) 2 Spalten Reserve, wird in E eingefügt.
zu 2 : wäre es nicht einfacher einfach den ganzen Kopf (Zeile1-3) zu kopieren und einzufügen?
Gruß
Chris

Anzeige
AW: kpopieren und eifügen
05.11.2007 06:52:00
volker
Hai Chris,
Danke für Deine Nachricht.
Zu 1 mach ich rein und test es durch.
Zu 2: Ich möchte "nur" erreichen, dass meine Liste in jeder Zeile mit den Kopfdaten versehen wird. Egal wie lange diese Liste ist.
Vielleicht kann man einzelne Bereiche noch mit übergeben.
Ich dachte irgendwie so: Wenn im Range (Artikeldaten) was steht, dann kopier zusätzlich noch den Range A1:A5 sowie C4:C6 und füg die dann mit in die Zeile ein, Position vergeben wie im Artikelbereich.
Erklärung:
Die Kopfdaten der BL_* Sheets werden automatisch gesetzt. Die benötigten Artikel nur teilweise, die restlichen Artikel fügt der Sachbearbeiter manuell hinzu.
Nun wird diese Liste auch gedruckt, deswegen die Ansicht in mehreren Kopfzeilen.
In jeder Hauptliste können unterschiedliche BL_* Sheets vorkommen. (der * ist für den Modellnamen)
Meine Übergabe soll erreichen, dass ich unter allen Daten suchen sortieren und was auch immer in einer Liste machen kann.
Wenn es irgendwie was bringt (einfacher gestaltet) kann ich den Kopfbereich auch umbauen.
Vielen Dank Gruss volker

Anzeige
AW: kpopieren und eifügen
05.11.2007 07:46:00
volker
Hai Chris,
weisst Du was, ich geb meine Kopfdaten einfach an meine Zeilen weiter setzt in mein makro ein automatischen ausfüllen dieser Zellen, dann sind diese auf jeden Fall ausgefüllt auch wenn der Sachbearbeiter Zeilen einfügt oder dgl.
Was meinst Du?
Danke Gruss volker

AW: kpopieren und eifügen
05.11.2007 10:27:29
Chris
Servus Volker,
ich meinte eigentlich so:
Range("A1:L3").Copy
u.s.w.
Hab's im Beispiel geändert (grüne Bemerkung im Code")
https://www.herber.de/bbs/user/47422.xls
Gruß
Chris

AW: Nachtrag
05.11.2007 10:29:52
Chris
Servus Volker,
du musst bei der geänderten Datei beim Zusatz lRow = lRow + 3, satt lRow = lRow + 1 schreiben, sind ja 3 Zeilen, die eingefügt werden.
Gruß
Chris

Anzeige
AW: Nachtrag
05.11.2007 12:05:15
volker
Hai Chris,
ich habs jetzt so gemacht.
Eines könntest Du mir noch helfen.
Ich möchte die Auslesedatei im Ursprungsordner löschen!!
Wie ?
Hier mein aktueller Code.
BESTEN Dank für Deine Hilfe Gruss volker

Sub Zeileneinlesen()
Dim oFS As Object, oFLDR As Object, oFILE As Object
Dim lRow As Long
Dim wkbMy As Workbook, wsMy As Worksheet, lngZeile As Long, lngLetzte As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFS = CreateObject("scripting.filesystemobject")
lRow = 2
Set oFLDR = oFS.getfolder("\\Server04\av\SharePoint_Beschlaglisten")
For Each oFILE In oFLDR.Files
If oFILE Like "*.xls" Or oFILE Like "*.xlsm" Or oFILE Like "*.xlsx" Then
lRow = lRow
Set wkbMy = Workbooks.Open(oFILE)
For Each wsMy In wkbMy.Worksheets
If wsMy.Name Like "BL_*" Then
Dim wsMyZeile As Long, wsMyletzte As Long
wsMyletzte = wsMy.Cells(Rows.Count, 1).End(xlUp).Row
For wsMyZeile = 5 To wsMyletzte
If wsMy.Cells(wsMyZeile, 1)  "" Then
wsMy.Range("A" & wsMyZeile & ":B" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 5).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("G" & wsMyZeile & ":N" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 7).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AA" & wsMyZeile & ":AD" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AE" & wsMyZeile & ":AF" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 13).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lRow = lRow + 1
End If
Next wsMyZeile
End If
Next
wkbMy.Close False
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Anzeige
AW: Nachtrag
05.11.2007 12:35:00
Chris
Servus,
probiers mal so:

Sub Zeileneinlesen()
Dim oFS As Object, oFLDR As Object, oFILE As Object
Dim lRow As Long
Dim wkbMy As Workbook, wsMy As Worksheet, lngZeile As Long, lngLetzte As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFS = CreateObject("scripting.filesystemobject")
lRow = 2
Set oFLDR = oFS.getfolder("\\Server04\av\SharePoint_Beschlaglisten")
For Each oFILE In oFLDR.Files
If oFILE Like "*.xls" Or oFILE Like "*.xlsm" Or oFILE Like "*.xlsx" Then
lRow = lRow
Set wkbMy = Workbooks.Open(oFILE)
For Each wsMy In wkbMy.Worksheets
If wsMy.Name Like "BL_*" Then
Dim wsMyZeile As Long, wsMyletzte As Long
wsMyletzte = wsMy.Cells(Rows.Count, 1).End(xlUp).Row
For wsMyZeile = 5 To wsMyletzte
If wsMy.Cells(wsMyZeile, 1)  "" Then
wsMy.Range("A" & wsMyZeile & ":B" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 5).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("G" & wsMyZeile & ":N" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 7).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AA" & wsMyZeile & ":AD" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AE" & wsMyZeile & ":AF" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 13).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lRow = lRow + 1
End If
Next wsMyZeile
End If
Next
wkbMy.Close False
Kill wkbMy ' Befehl für das löschen der Datei
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Aber erstmal testen, bevor du auf die Ursprungsdateien losgehst.
Gruß
Chris

AW: Nachtrag
05.11.2007 13:34:00
volker
Servus Chris,
folgender Fehler:
Laufzeitfehler 424
Objekt erforderlich
kann es sein dass das aktuelle Workbook "namentlich"!definiert sein muss?
Danke Gruss volker

AW: Nachtrag
05.11.2007 16:11:11
Chris
Naja,
wahrscheinlich weiß Excel nicht, um welche Datei es geht. Deswegen musst du dieses Makro _ einbauen, da wo jetzt Kill steht, allerdings muss der name vor dem Schließen der Datei ausgelesen werden und das

Sub und end 

Sub muss natürlich weg.


Sub Killen()
Set fs = Application.FileSearch
With fs
.LookIn = "C:\..." ' Hier der Pfad
.SearchSubFolders = True ' Kann man rausnehmen, wenn es ein bestimmter Ordner ist, in dem die  _
datei liegt
.Filename = wkbMyName  ' Hier der Dateiname, muss vorher ausgelesen worden sein, z.B.:  _
WkbMyName = ActiveWorkbook.Name
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Kill .FoundFiles(i)
Next i
End If
End With
End Sub


Gruß
Chris

AW: Nachtrag
06.11.2007 06:34:00
volker
Hai Chris,
ja so sehe ich das auch. Aber ich bin zu dappig und bekomms nicht eingebaut.
Ich hab hier nochmals meinen Code wo es rein soll.
Wäre nett wenn Du den Code da unterbringen kannst.
Danke volker

Sub Zeileneinlesen()
Dim oFS As Object, oFLDR As Object, oFILE As Object
Dim lRow As Long
Dim wkbMy As Workbook, wsMy As Worksheet, lngZeile As Long, lngLetzte As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oFS = CreateObject("scripting.filesystemobject")
lRow = 2
Set oFLDR = oFS.getfolder("\\Server04\av\SharePoint_Beschlaglisten")
For Each oFILE In oFLDR.Files
If oFILE Like "*.xls" Or oFILE Like "*.xlsm" Or oFILE Like "*.xlsx" Then
lRow = lRow
Set wkbMy = Workbooks.Open(oFILE)
For Each wsMy In wkbMy.Worksheets
If wsMy.Name Like "BL_*" Then
Dim wsMyZeile As Long, wsMyletzte As Long
wsMyletzte = wsMy.Cells(Rows.Count, 1).End(xlUp).Row
For wsMyZeile = 5 To wsMyletzte
If wsMy.Cells(wsMyZeile, 1)  "" Then
wsMy.Range("A" & wsMyZeile & ":B" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 5).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("G" & wsMyZeile & ":N" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 7).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AA" & wsMyZeile & ":AD" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AE" & wsMyZeile & ":AF" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 13).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lRow = lRow + 1
End If
Next wsMyZeile
End If
Next
wkbMy.Close False
''Kill wkbMy ' Befehl für das löschen der Datei
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige