Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1700to1704
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
Inhaltsverzeichnis

Tabellen ohne Kopfzeile kopieren und ergänzen

Tabellen ohne Kopfzeile kopieren und ergänzen
23.07.2019 16:50:36
Gertrud
Guten Tag,
ich möchte gerne ein Makro schreiben, das andere Tabellen in anderen Exceldateien markiert (ohne die Kopfzeile) und dann damit die Tabelle in meinem aktuellen Exceldokument ergänzt bzw. die Tabelle erweitert. Die Tabellen sind alle gleich aufgebaut und haben die selben Spaltennamen. Im grundegenommen will ich also nur meine Tabelle mit den Werten der anderen Tabelle erweitern.
Ich habe durch google auch schon Code gefunden, weiß jedoch nicht wie ich ihn weiter anpassen soll.

Sub TblImport()
Dim vntPathAndFileNames As Variant 'kein String !
Dim strPathAndFile As String
Dim lngI As Long
Dim wbkMappe As Workbook
Dim wks As Worksheet
Dim wbkZiel As Workbook
Dim zaehlerspalten1 As Integer
Dim zaehlerspalten2 As Integer
Dim rngCopy As Range
Dim finalLocation As Variant
Application.ScreenUpdating = False
Set wbkZiel = ThisWorkbook
vntPathAndFileNames = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
Title:="Zu importierende Dokumente auswählen", _
MultiSelect:=True)
If VarType(vntPathAndFileNames) = vbBoolean Then
MsgBox "Abgebrochen!"
Else
For lngI = LBound(vntPathAndFileNames) To UBound(vntPathAndFileNames)
strPathAndFile = vntPathAndFileNames(lngI)
Set wbkMappe = Application.Workbooks.Open(strPathAndFile)
For Each wks In wbkMappe.Worksheets
----[Ich nehme an hier müsste ich ergänzen]-----
Next
wbkMappe.Close False
Next
End If
Set wbkZiel = Nothing
End Sub
Vielen lieben Dank
Gertrud

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellen ohne Kopfzeile kopieren und ergänzen
24.07.2019 09:51:09
Torsten
Hallo Gertrud,
Frage: Stehen die Kopfzeilen der Tabellen immer in der 1.Zeile?
Gruss Torsten
AW: Tabellen ohne Kopfzeile kopieren und ergänzen
24.07.2019 10:01:30
Gertrud
Ja, die Kopfzeilen stehen immer in der ersten Zeile.
Gruß
Gertrud
AW: Tabellen ohne Kopfzeile kopieren und ergänzen
24.07.2019 12:58:16
Torsten
Hallo Gertrud,
der Code oben zur Dateiauswahl funktioniert ja schon. Ich habe dir mal den Code zum Kopieren ergaenzt. Habe auch Kommemntare eingefuegt, sodass du nachvollziehen kannst, was der Code macht.
Du musst eventuell noch Spalten-, Zeilennummern und Tabellennamen anpassen, falls noetig.
Wenn du dabei Hilfe brauchst, sag nochmal bescheid.

Sub TblImport()
Dim vntPathAndFileNames As Variant 'kein String !
Dim strPathAndFile As String
Dim lngI As Long, LZM As Long, LSM As Long, LZZ
Dim wbkMappe As Workbook
Dim wks As Worksheet
Dim wbkZiel As Workbook
Dim zaehlerspalten1 As Integer
Dim zaehlerspalten2 As Integer
Dim rngCopy As Range
Dim finalLocation As Variant
Application.ScreenUpdating = False
Set wbkZiel = ThisWorkbook
vntPathAndFileNames = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx",  _
Title:="Zu importierende Dokumente auswählen", MultiSelect:=True)
If VarType(vntPathAndFileNames) = vbBoolean Then
MsgBox "Abgebrochen!"
Else
For lngI = LBound(vntPathAndFileNames) To UBound(vntPathAndFileNames)
strPathAndFile = vntPathAndFileNames(lngI)
Set wbkMappe = Application.Workbooks.Open(strPathAndFile)
For Each wks In wbkMappe.Worksheets
With wks
LZM = .Cells(Rows.Count, 1).End(xlUp).Row   'letzte Zeile wbkMappe
LSM = .Cells(2, Columns.Count).End(xlToLeft).Column  'letzte Spalte wbkMappe
.Range(.Cells(2, 1), .Cells(LZM, LSM)).Copy   'kopieren von A2 bis letzte Zeile,  _
letzte Spalte
LZZ = wbkZiel.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1   'letzte Zeile +  _
1 wbkZiel, hier das aktive Blatt
wbkZiel.Range(Cells(LZZ, 1)).PasteSpecial xlPasteValues  'Werte einfuegen ab Spalte  _
A, erste freie Zeile
End With
Application.CutCopyMode = False   'Zwischenspeicher leeren, Kopiermarkierung aufheben
Next
wbkMappe.Close False
Next
End If
Set wbkZiel = Nothing
End Sub
Gruss Torsten

Anzeige
AW: Tabellen ohne Kopfzeile kopieren und ergänzen
26.07.2019 10:15:10
Gertrud
Hallo Torsten,
erst einmal vielen Dank für die Ergänzung. Nachvollziehen kann ich nun die Schritte jedoch kriege ich nun folgende Fehlermeldung: Laufzeitfehler 438: Objekt unterstützt diese Eigenschaft oder Methode nicht und markiert mir folgende Zeile mit dem Fehler

wbkZiel.Range(Cells(LZZ, 1)).PasteSpecial xlPasteValues  'Werte einfuegen ab Spalte  _
A, erste freie Zeile
Gruß Gertrud
AW: Tabellen ohne Kopfzeile kopieren und ergänzen
26.07.2019 13:52:31
Piet
Hallo Gertrud
ohne die Datei selbst testen zu können vermute ich hier den Fehler:
wbkZiel.Range(Cells(LZZ, 1)).PasteSpecial xlPasteValues - Probier es bitte mal so:
wbkZiel.Cells(LZZ, 1).PasteSpecial xlPasteValues
mfg Piet
Anzeige

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige