Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
19.04.2024 13:58:02
Set Worksheet geht im O365 aber im Excel 2016 nicht
19.04.2024 13:49:38
Per Kopfdruck als pdf speichern und Mail erstellen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1516to1520
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1516to1520
1516to1520
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren von Mappe

Kopieren von Mappe
29.09.2016 11:39:06
Mappe
Hallo !
Ich habe diesen Code der mir in einer Mappe aus dem Tabellenblatt "quelle" die Spalten
B, C und I in das TB "ziel" in die Spalten A, B und C die Werte überträgt.
Meine Frage ist: Kann man den Code so gestalten, das man von einer anderen Datei die zum Auswählen geht (der Name der angelieferten Datei ändert sich fallweise) die gleichen Spalten in eine neue Mappe reinkopieren kann ?
Bitte um Hilfe - Danke vielmals
chris
Sub Spaltenkopieren()
Sheets("ziel").Columns("A").Value = Sheets("quelle").Columns("B").Value
Sheets("ziel").Columns("B").Value = Sheets("quelle").Columns("C").Value
Sheets("ziel").Columns("C").Value = Sheets("quelle").Columns("I").Value
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren von Mappe
29.09.2016 11:57:13
Mappe
Hallo Chris,
benutze folgenden Code um bestimmte Spalten aus einer Datei in eine andere Datei zu kopieren; allerdings hat die ausgewählte Datei bei mir immer den selben Namen.
Sub Daten_uebertragen()
' Daten aus einer anderen Excel Datei auslesen und übertragen
Dim sFile As String, sPath As String
sFile = "Original.xlsx"
sPath = ThisWorkbook.Path & "\" & sFile
Dim lz01&, i&
Const von = "D,AM,AH,AC" ' Spalten, die kopiert werden
Const nach = "A,B,C,D" ' Spalten, wo die Daten eingefügt werden
Dim aVon, aNach
aVon = Split(von, ",")
aNach = Split(nach, ",")
'Aktualisierung der Anzeige von Excel abgeschaltet
Application.ScreenUpdating = False
' Abschaltung der Zwischenablage
Application.DisplayAlerts = False
'Löschen der alten Daten A2 bis letzte Zelle D -anpassen-
Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Resize(, 4).ClearContents
If WkbExists("Original.xlsx") = False Then
If Dir(sPath) = "" Then
MsgBox "Datei " & sPath & " wurde nicht gefunden!"
Else
Workbooks.Open sPath
End If
Else
Workbooks(sFile).Activate
End If
Windows("Original.xlsx").Activate
lz01 = Range("D" & Cells.Rows.Count).End(xlUp).Row
For i = 0 To UBound(aVon)
Sheets(1).Range(aVon(i) & "2").Resize(lz01 - 1).Copy ThisWorkbook.Sheets(" _
Tabellenblattname").Range(aNach(i) & "2")
Next
'Leerung der Zwischenablage
Application.CutCopyMode = False
'Datei Original.xlsx wird geschlossen
Windows("Original.xlsx").Close SaveChanges:=False
Cells(1, 1).Select
' Einschaltung der Zwischenablage
Application.DisplayAlerts = True
'Aktualisierung der Anzeige von Excel angeschaltet
Application.ScreenUpdating = True
End Sub
Der Code kommt von einem Namensvetter von mir (habe ihn nur angepasst):
https://www.herber.de/cgi-bin/callthread.pl?index=1495299
Vorletzter Beitrag test2
Vielleicht kannst du damit was anfangen.
Gruß
Michael
Anzeige
AW: Kopieren von Mappe
29.09.2016 12:25:56
Mappe
Hallo Michael !
Danke erstmals. Ich habe den Code angepasst......glaub ich halt.
Die Quelldatei und die Spalten.
Da kommt dann immer ein Fehler.........weißt du warum ?
Würdest du mir nochmals helfen ?
Danke chris
Hier der angepasste Code:
Sub Daten_uebertragen()
' Daten aus einer anderen Excel Datei auslesen und übertragen
Dim sFile As String, sPath As String
sFile = "janosP.xls" ' Quelldatei
sPath = ThisWorkbook.Path & "\" & sFile
Dim lz01&, i&
Const von = "B,C,I" ' Spalten, die kopiert werden
Const nach = "A,B,C" ' Spalten, wo die Daten eingefügt werden
Dim aVon, aNach
aVon = Split(von, ",")
aNach = Split(nach, ",")
'Aktualisierung der Anzeige von Excel abgeschaltet
Application.ScreenUpdating = False
' Abschaltung der Zwischenablage
Application.DisplayAlerts = False
'Löschen der alten Daten A2 bis letzte Zelle D -anpassen-
Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Resize(, 4).ClearContents
If WkbExists("janosP.xls") = False Then  ?hier hängt er sich auf?
If Dir(sPath) = "" Then
MsgBox "Datei " & sPath & " wurde nicht gefunden!"
Else
Workbooks.Open sPath
End If
Else
Workbooks(sFile).Activate
End If
Windows("janosP.xls").Activate
lz01 = Range("C" & Cells.Rows.Count).End(xlUp).Row
For i = 0 To UBound(aVon)
Sheets(1).Range(aVon(i) & "2").Resize(lz01 - 1).Copy ThisWorkbook.Sheets(" _
Tabellenblattname").Range(aNach(i) & "2") ? der Teil ist rot eingefärbt ?
Next
'Leerung der Zwischenablage
Application.CutCopyMode = False
'Datei Original.xlsx wird geschlossen
Windows("janosP.xls").Close SaveChanges:=False
Cells(1, 1).Select
' Einschaltung der Zwischenablage
Application.DisplayAlerts = True
'Aktualisierung der Anzeige von Excel angeschaltet
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Kopieren von Mappe
29.09.2016 12:36:12
Mappe
Hallo,
1. dir fehlt wohl die Funktion wkbExists. 
Function wkbExists(strWKB As String) As Boolean
Dim wkb As Workbook
For Each wkb In Workbooks
If LCase(wkb.Name) = LCase(strWKB) Then
wkbExists = True
Exit Function
End If
Next
End Function
2. lösche hinten den _ und den Zeilenumbruch.
Gruß
Rudi
AW: Kopieren von Mappe
29.09.2016 12:59:18
Mappe
Hallo Chris,
sorry, ich hab den von Rudi aufgeführten Code vergessen :-( (Dank an Rudi).
Hinsichtlich "der Teil ist rot eingefärbt":
Sheets("Tabellenblattname").. hier muss der von dir ausgesuchte Tabellenblattname, also ziel, eingetragen werden.
Gruß
Michael
Anzeige
AW: Übertrag von 2 Tabellenblätter
29.09.2016 14:42:34
2
Hallo !
Ich bedanke mich für die rasche Hilfe bezüglich des kopierens einer Mappe, habe jedoch noch ein Frage bezüglich zusammenführen der Daten im selben Ordner.
Ich "glaubte" mit meinem Code ginge das ich von 2 Tabellenblättern alle Daten hintereinander in ein bereinigtes Tabellenblatt überführen könnte - Schnappsidee.
Kann mir bitte wer sagen, wie ich das ändern könnte, damit ich das erfolgreich machen kann.
Bei einem Tabellenblatt geht das ja einwandfrei, doch mit 2 Tabellenblättern werden die Daten überschreiben.
Danke für die Hilfe
chris
Hier der Code:
Sub Spaltenkopieren()
Sheets("Bereinigt").Columns("A").Value = Sheets("JanosP").Columns("A").Value
Sheets("Bereinigt").Columns("B").Value = Sheets("JanosP").Columns("B").Value
Sheets("Bereinigt").Columns("C").Value = Sheets("JanosP").Columns("C").Value
Sheets("Bereinigt").Columns("A").Value = Sheets("Ipa").Columns("A").Value
Sheets("Bereinigt").Columns("B").Value = Sheets("Ipa").Columns("B").Value
Sheets("Bereinigt").Columns("C").Value = Sheets("Ipa").Columns("C").Value
End Sub

Anzeige
AW: Übertrag von 2 Tabellenblätter
29.09.2016 20:41:06
2
Hallo Chris,
dann musst du das anders machen. 
Sub Spaltenkopieren()
Dim i As Integer
Application.ScreenUpdating = False
Sheets("Bereinigt").Columns("A").Clear
With Sheets("JanosP")
For i = 1 To 3
.Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp)).Copy
Sheets("Bereinigt").Cells(1, i).PasteSpecial xlPasteValues
Next i
End With
With Sheets("Ipa")
For i = 1 To 3
.Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp)).Copy
Sheets("Bereinigt").Cells(Rows.Count, i).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Next i
End With
End Sub

bzw. wenn alle Spalten gleich gefüllt sind 
Sub Spaltenkopieren()
Application.ScreenUpdating = False
Sheets("Bereinigt").Columns("A").Clear
With Sheets("JanosP")
.Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 3).Copy
Sheets("Bereinigt").Cells(1, 1).PasteSpecial xlPasteValues
End With
With Sheets("Ipa")
.Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 3).Copy
Sheets("Bereinigt").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
End Sub
Gruß
Rudi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige