Hallo Leute,
Ich habe habe eine Excel Liste mit ca. 10000 Zeilen.
Daran arbeiten mehrere Leute. Ich möchte jetzt dann von den einzelnen Datein die Spalte C ( Kolumne 3 ) in eine Datei rein kopieren. Leider funkt das nicht so ganz mit copy and paste, er macht da irgendwie Blöcke daraus und kopiert es leider nur teilweise. Hab mit vba leider nur wenige Grundkentnisse und weiß nicht wie ich da mit mehreren Datein arbeiten soll.
Kann mir da mal jemand helfen?
Danke im voraus
MFG enes
Hallo enes,
also eigentlich hat Excel keine Schwierigkeiten damit, eine entsprechende Spalte zu kopieren und abzulegen. Der Befehl würde wie folgt lauten:
Columns(„C:C“).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
In diesem Fall würde eine neue Datei angelegt werden und die kopierten Daten in die Spalte A abgelegt. Zieldatei und Zielspalte könnte man natürlich auch konkret benennen.
Wie ist das mit den „mehreren Dateien“ gemeint? Soll aus verschiedenen Dateien die Spalte C kopiert werden?
Viele Grüße
Natator
Hallo Natator,
Danke mal für die Hilfe.
Es arbeiten 3 Leute an der selben Datei und jeder hat sie bei sich abgespeichert. Von denen trägt jede Zahlen in diese C Spalte der Datei ein. Ich möchte dann das ganze in die ursprngliche Datei zusammen kopieren.
MFG enes
Hallo enes,
jetzt habe ich es verstanden.
Damit sollte dir geholfen sein. Datei- und Tabellennamen müssen noch entsprechend angepasst werden:
Sub Dateien_Zusammenkopieren()
’
’ Alle Dateien öffnen
’ Sie müssen alle unterschiedliche Namen haben
’
Application.ScreenUpdating = False
Dim QUELLE1, QUELLE2, QUELLE3, ZIEL As Object
Workbooks(„Zieldatei.xls“).Activate 'Dateinamen entsprechend anpassen
Set ZIEL = ActiveWorkbook
Workbooks(„Quelldatei1.xls“).Activate 'Dateinamen entsprechend anpassen
Set QUELLE1 = ActiveWorkbook
Workbooks(„Quelldatei2.xls“).Activate 'Dateinamen entsprechend anpassen
Set QUELLE2 = ActiveWorkbook
Workbooks(„Quelldatei3.xls“).Activate 'Dateinamen entsprechend anpassen
Set QUELLE3 = ActiveWorkbook
ZIEL.Activate
zeile = 1
For i = 1 To 10000
inhalt = QUELLE1.Sheets(„Tabelle1“).Cells(i, 3).Value 'Tabellennamen entsprechend anpassen
ZIEL.Sheets(„Tabelle1“).Cells(zeile, 3).Value = inhalt
zeile = zeile + 1
inhalt = QUELLE2.Sheets(„Tabelle1“).Cells(i, 3).Value 'Tabellennamen entsprechend anpassen
ZIEL.Sheets(„Tabelle1“).Cells(zeile, 3).Value = inhalt
zeile = zeile + 1
inhalt = QUELLE3.Sheets(„Tabelle1“).Cells(i, 3).Value 'Tabellennamen entsprechend anpassen
ZIEL.Sheets(„Tabelle1“).Cells(zeile, 3).Value = inhalt
zeile = zeile + 1
Next i
End Sub
Die Daten werden jetzt sequentiell untereinander geschrieben. Falls es erforderlich ist, dass jede Datei im Block kopiert werden muss, sag bescheid.
Dafür ist nur eine kleine Umstellung nötig.
Viele Grüße
Natator
hier kann ich leider nicht helfen
Hallo Leute,
Ich habe habe eine Excel Liste mit ca. 10000 Zeilen.
Daran arbeiten mehrere Leute. Ich möchte jetzt dann von den
einzelnen Datein die Spalte C ( Kolumne 3 ) in eine Datei rein
kopieren. Leider funkt das nicht so ganz mit copy and paste,
Danke im voraus
MFG enes
Hallo, wenn es gefilterte listen sin: bearbeiten/gehe zu / Inhalte / nur sichtbare zellen kopieren
Gruß
M.W.
Hallo enes,
Ich würd den Code,mit den Makrorecorder aufgezeichnet.
Den Code dann noch anpassen das wars!
MFG Fred
hallo enesc1,
folgender Ansatz wäre eine Möglichkeit:
’ Aus Tabelle2 in Tabelle1 Spalte-C kopieren
Private Sub CommandButton1_Click()
Worksheets(„Tabelle2“).Range(„C:C“).Copy
ActiveSheet.Paste Destination:=Worksheets(„Tabelle1“).Range(„A3:C3“)
End Sub
Einfach komplettes Script in ein Modul einfügen und dann starten.
Wenn du nicht weißt, wie das geht, laß mir deine eMail-Adresse zukommen und ich sende die eine fertige Datei.
mfg
Softoldi
das wäre meine lösung:
Private Sub CommandButton1_Click()
Dim bereich As Range
With Application
Set bereich = .InputBox(„Zielbereich auswählen“, Type:=8)
.ScreenUpdating = False
.Workbooks.Open(Application.GetOpenFilename).Activate
.DisplayAlerts = False
Sheets(1).Range(„C:C“).Copy
ActiveWorkbook.Close
bereich.PasteSpecial
.ScreenUpdating = True
End With
End Sub
Hallo enes,
hier ein Beispiel, dass du noch etwas anpassen musst.
Die Zielmappe muss beim Start des Makros geöffnet sein. Die Datei(en) mit den Daten, die kopiert werden sollen, sind geschlossen.
In einem Dateiauswahldialog kannst du die Datei(en) auswählen, aus denen die Daten kopiert werden sollen.
Falls die Index-Nummer oder der Name des Tabellenblattes wechselt, dann muss hier nach dem Öffnen der Quelldatei noch etwas angepasst werden. Inputbox oder ganz komfortabel mit Userform für die Blattauswahl.
Gruß
Franz
Sub HoleDaten()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet, vAuswahl
Dim ZeileZiel As Long
On Error GoTo Fehler
'Zielmappe setzen
Set wbZiel = Workbooks("MappeZiel.xls")
'oder
Set wbZiel = ActiveWorkbook 'wenn Zielmappe beim Start des Makros die aktive Mappe ist
'Zieltabellenblatt setzen
Set wksZiel = wbZiel.Worksheets("TabelleZiel")
'Dateiauswahldialog anzeigen
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Auswählen"
.AllowMultiSelect = True
.Title = "Bitte eine oder mehrere Dateien der Kollegen auswählen"
If .Show False Then
Application.ScreenUpdating = False
For Each vAuswahl In .SelectedItems
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
'Zieltabelle setzen (1. Tabellenblatt in geöffneter Datei)
Set wksQuelle = wbQuelle.Worksheets(1)
'Letzte Datenzeile in Zielspalte des Zielblattes - hier Spalte 1 (A)
ZeileZiel = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row
'Zeile ab der Dateneingefügt werden sollen
ZeileZiel = ZeileZiel + 1
'Daten kopieren
With wksQuelle
'Quellzellen C1:Cxxx kopieren
.Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)).Copy \_
Destination:=wksZiel.Cells(ZeileZiel, 1)
'oder wenn nur Werte kopiert werden sollen
.Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)).Copy
wksZiel.Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
End With
'Quelldatei wieder schliessen
wbQuelle.Close savechanges:=False
Next
Application.ScreenUpdating = True
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbInformation, \_
"Fehler in Prozedur ""DatenHolen"""
End Select
End With
'Objektvariablen aufräumen
Set wbZiel = Nothing: Set wksZiel = Nothing
Set wbQuelle = Nothing: Set wksQuelle = Nothing
End Sub
Hallo Leute,
Wirklich danke an alle die mir hier geantwortet und eine Lösung geschickt haben. Echt klasse.
Ihr seid die BESTEN 
Mit freundlichen Grüßen
Hallo enes,
da ich nicht der VBA-Experte bin kann ich dazu keine Lösung anbieten. Ich hätte bei 10.000 Zeilen aber auch mit copy&paste gearbeitet (in ein Excelblatt passen bei MS-Office 2003 nur die Daten von 6 Blättern rein.
Bei der Blockbildung könnte es sein, dass die Daten nicht in Werte umgewandelt wurden nach dem Einfügen.
Ich hoffe die Info konnte geringfügig weiter helfen.
Gruß Hugo
Hallo,
mit VBA sollte es so funktionieren:
sub kopieren_Spalte_C
Sheets(„Deine Datei“).select
Range(„C:C“).select
selection.copy
Workbooks.Open Filename:= _
„C:\Deine_Zieldatei.XLS“
Range(„C:C“).select
selection.paste
End sub
Gruß,
ptonka
Grüezi enes
Ich habe habe eine Excel Liste mit ca. 10000 Zeilen.
Daran arbeiten mehrere Leute. Ich möchte jetzt dann von den
einzelnen Datein die Spalte C ( Kolumne 3 ) in eine Datei rein
kopieren. Leider funkt das nicht so ganz mit copy and paste,
er macht da irgendwie Blöcke daraus und kopiert es leider nur
teilweise. Hab mit vba leider nur wenige Grundkentnisse und
weiß nicht wie ich da mit mehreren Datein arbeiten soll.
Kann mir da mal jemand helfen?
Hmmm, wenn Du die ganze Spalte C über den Spaltenkopf oben markierst sollte es doch möglich sein mit STRG+C diese Spalte zu kopieren und in einer anderen Mappe mit STRG+V wieder einzufügen?
Wobei stösst Du hier auf Probleme?
Mit freundlichen Grüssen
Thomas Ramel
Hallo thomas,
Diese Liste hat Autofilter eingeschaltet. Ich weiß zwar nicht warum aber es geht nicht, hab das schon probiert mit der ganzen Spalte zu kopieren - ohne erfolg. Er macht Blöcke daraus und kopiert nsie nur teilwiese obwohl ich alle Zellen markiere.
Aber troztdem danke für deine Antwort - ich hab schon ein Lösung mit VBA 
Mit freundlichen Grüßen
Hallo Franz,
Danke für das Programm. Es funktioniert nicht ganz richtig. Das Prgramm läuft Fehlerfrei aber es kopiert nicht die ganze Spalte C ( Kolumne 3 ).
Habe ich villeicht vergessen etwas zu ändern?
Sub HoleDaten()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet, vAuswahl
Dim ZeileZiel As Long
On Error GoTo Fehler
'Zielmappe setzen
'Set wbZiel = Workbooks(„MappeZiel.xls“)
'oder
Set wbZiel = ActiveWorkbook 'wenn Zielmappe beim Start des Makros die aktive Mappe ist
'Zieltabellenblatt setzen
Set wksZiel = wbZiel.Worksheets(„Tabelle1“)
'Dateiauswahldialog anzeigen
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = „Auswählen“
.AllowMultiSelect = True
.Title = „Bitte eine oder mehrere Dateien der Kollegen auswählen“
If .Show False Then
Application.ScreenUpdating = False
For Each vAuswahl In .SelectedItems
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
'Zieltabelle setzen (1. Tabellenblatt in geöffneter Datei)
Set wksQuelle = wbQuelle.Worksheets(1)
'Letzte Datenzeile in Zielspalte des Zielblattes - hier Spalte 1 (A)
ZeileZiel = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row
'Zeile ab der Dateneingefügt werden sollen
ZeileZiel = ZeileZiel + 1
'Daten kopieren
With wksQuelle
'Quellzellen C1:Cxxx kopieren
'.Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)).Copy _
'Destination:=wksZiel.Cells(ZeileZiel, 1)
'oder wenn nur Werte kopiert werden sollen
.Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)).Copy
wksZiel.Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
End With
'Quelldatei wieder schliessen
wbQuelle.Close savechanges:=False
Next
Application.ScreenUpdating = True
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbInformation, _
„Fehler in Prozedur „„DatenHolen“““
End Select
End With
'Objektvariablen aufräumen
Set wbZiel = Nothing: Set wksZiel = Nothing
Set wbQuelle = Nothing: Set wksQuelle = Nothing
End Sub
Servus Franz,
Das Programm funktioniert einwandfrei. Ich habe jetz gesehen dass er dann das , was er kopiert , ab der letzen Zeile in der Tabelle reinkopiert.
ZeileZiel = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row
'Zeile ab der Dateneingefügt werden sollen
ZeileZiel = ZeileZiel + 1
Kann ich das so ändern dass er die Sachen einfach reinkopiert ab der ersten Zeile? Also, es ist nämlich so dass die Leute immer etwas raus filtern aus der Liste, jeder macht einen Teil , aber durcheinander, also nicht untereinander in der Liste.
Kann ich dann einfach diese Zeile weg löschen damit es funktioniert oder ist es dann komplizierter?
Mit freundlichen Grüßen
hallo enesc,
ich tippe mal, dass gelegentlich auch noch der Autofilter in den Quelldateien gesetzt ist, dann werden nur die sichtbaren Daten kopiert.
Wenn immer in die Zeile 1 kopiert werden soll, dann wird das Ganze einfacher, allerdingt darf dann auch immer nur eine Datei als Quelle gewählt werden. In deiner ursprünglichen Frage klang das so als ob du die Daten aus den Dateien von mehreren Kollegen in ein einzelnes Tabellenblatt kopieren wolltest. Deshalb die etwas aufwendigere Form. (For-Next-Schleife, ZielZeile immer wieder neu berechnne).
Gruß
Franz
Option Explicit
Sub HoleDaten()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet, vAuswahl
Dim ZeileZiel As Long
On Error GoTo Fehler
'Zielmappe setzen
'Set wbZiel = Workbooks("MappeZiel.xls")
'oder
Set wbZiel = ActiveWorkbook 'wenn Zielmappe beim Start des Makros die aktive Mappe ist
'Zieltabellenblatt setzen
Set wksZiel = wbZiel.Worksheets("Tabelle1")
'Dateiauswahldialog anzeigen
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Auswählen"
.AllowMultiSelect = False
.Title = "Bitte eine der Dateien der Kollegen auswählen"
If .Show False Then
Application.ScreenUpdating = False
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=.SelectedItems(1), ReadOnly:=True)
'Zieltabelle setzen (1. Tabellenblatt in geöffneter Datei)
Set wksQuelle = wbQuelle.Worksheets(1)
ZeileZiel = 1
'Daten kopieren
With wksQuelle
'Prüfen, ob der Autofilter gesetzt ist
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
End If
'vorhande Inhalte in Zielspalte löschen
wksZiel.Columns(1).ClearContents
'Werte kopieren aus Spalte C der Quelle
.Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)).Copy
wksZiel.Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
'Quelldatei wieder schliessen
wbQuelle.Close savechanges:=False
Application.ScreenUpdating = True
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbInformation, \_
"Fehler in Prozedur ""DatenHolen"""
End Select
End With
'Objektvariablen aufräumen
Set wbZiel = Nothing: Set wksZiel = Nothing
Set wbQuelle = Nothing: Set wksQuelle = Nothing
End Sub
Hallo Franz,
Danke noch mals für die Info. Ja, du hast richtig geraten, sie habe ein Auto filter eingeschaltet. Sorry dass ich mit solche Infos nicht schon vorher rausgerückt habe.
Warscheinlich werde ich schon langsam lästig aber mein Problem ist leider noch nicht ganz gelöst. Es ist so, wenn er jetz die Daten von der anderen Datei Spalte C in die Usrprüngliche Datei Spalte C reinkopiert, dann überschreibt er auch die Zellen wo bereits was drin steht und die sind dann leer.
Ja, ich habe das mit dem Clear Contents weg gelassen.
Er kopiert die leeren Zellen auch mit.
Am besten erklär ich es dir mit einem Beipiel:
Also in Datei XYZ sind in der Kolumne 3 in der ersten , vierten und achten Zeile Werte schon drin. In der Datei FDG sind in der Kolumne 3 in der zweiten,dritten,fünften,sechsten und siebenten Zeile Werte drin.
Er soll die Werte in der Datei XYZ nicht überschreiben, sondern die fehlenden von der anderen Datei holen. Das ganze dann über 10000 Zeilen.
Geht das?
Danke im voraus
Mit freundlichen Grüßen
Enes
Hallo Enes,
manchmal dauert es halt bis man alle notwendigen Informationen bereitgestellt sind.
Bei der Datenlage bleibt dann nichts anderes über, als Zeile für Zeile die Spalte A in der Zieltabelle zu prüfen und falls leer, dann die Daten aus der entsprechenden Zeile der Quelle zu übernehmen. Ich hab zusätzlich eine Prüfung eingebaut, dass nur die in der Quelle sichtbaren Zeilen eingelesen werden. Evtl. diese Prüfung wieder rausnehmen.
Du kannst dann natürlich auch mehrere Datei der Kollegen auswählen und in einem Rutsch einlesen.
Gruß
Franz
Sub HoleDaten()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet, vAuswahl
Dim Zeile As Long, ZeileL As Long
On Error GoTo Fehler
'Zielmappe setzen
Set wbZiel = ActiveWorkbook 'wenn Zielmappe beim Start des Makros die aktive Mappe ist
'Zieltabellenblatt setzen
Set wksZiel = wbZiel.Worksheets("Tabelle1")
'Dateiauswahldialog anzeigen
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Auswählen"
.AllowMultiSelect = True
.Title = "Bitte eine oder mehrere Dateien der Kollegen auswählen"
If .Show False Then
Application.ScreenUpdating = False
For Each vAuswahl In .SelectedItems
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
Application.StatusBar = "Datei """ & wbQuelle.Name & """ wird bearbeitet"
'Zieltabelle setzen (1. Tabellenblatt in geöffneter Datei)
Set wksQuelle = wbQuelle.Worksheets(1)
With wksQuelle
'letzte Zeile mit Daten in Spalte C (3)
ZeileL = .Cells(.Rows.Count, 3).End(xlUp).Row
'Zeilen von Zeile 1 bis zur letzten Zeile abarbeiten
For Zeile = 1 To ZeileL
'Anzeige des Forschritts in der Statusanzeige, alle 500 Zeilen aktualisieren
If Zeile Mod 500 = 0 Then
Application.StatusBar = "Datei """ & wbQuelle.Name & """ wird bearbeitet, Zeile: " \_
& Zeile & " von " & ZeileL
End If
'Prüfen ob Zelle in Zieltabelle leer ist
If IsEmpty(wksZiel.Cells(Zeile, 1)) Then
'Prüfen, ob Zeile in Quelle sichtbar ist
If .Rows(Zeile).Hidden = False Then
'Wert aus Quelle Spalte C (3) in Ziel Spalte A (1) eintragen
wksZiel.Cells(Zeile, 1).Value = .Cells(Zeile, 3).Value
End If
End If
Next
End With
'Quelldatei wieder schliessen
wbQuelle.Close savechanges:=False
Next
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Fertig", vbInformation, "Daten Holen"
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbInformation, \_
"Fehler in Prozedur ""DatenHolen"""
End Select
End With
Application.StatusBar = False
'Objektvariablen aufräumen
Set wbZiel = Nothing: Set wksZiel = Nothing
Set wbQuelle = Nothing: Set wksQuelle = Nothing
End Sub