Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1596to1600
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

HILFE: Intelligentes Kopieren Makro verbessern

HILFE: Intelligentes Kopieren Makro verbessern
13.12.2017 19:26:27
Ralf
Hallo liebe Community,
Ich habe eine große Datenbank (im ff. Zieldatei) mit ca 2500 Reihen und 524 Spalten.
Diese Datenbank wird monatlich geupdated indem aus mehreren Quellexceldateien im selben Sheet Daten kopiert werden und in der Zieldatei unten eingefügt werden.
Um diesen Vorgang zu automatisieren habe ich bereits ein Makro mit meinen bescheidenen Kenntnissen und mithilfe des Internets gebastelt. Das Makro öffnet alle Quelldateien in einem best. Ordner kopiert die Daten und fügt diese in die Zieldatei unten ein.
NUN MEIN PROBLEM: Bei den Quelldateien ist der Bereich mit den notwendigen Informationen unterschiedlich groß. Bsp der maximal Bereich ist C18:TF27. Manchmal jedoch sind es in einer Datei nur 5 Reihen die kopiert werden sollen. C18:TF22 (Beispiel)
Dadurch kommt es beim Einfügen komischerweise zu leeren Reihen..
Hier mein bisheriges Makro:
Sub Ursprüngliches_Makro()
Dim Pfad As String, Dateiname As String, Reihe As Long
Application.ScreenUpdating = False
Pfad = “Beispielpfad….”
Dateiname = Dir(Pfad & "*.xls")
Do While Dateiname  ""
Workbooks.Open Filename:=Pfad & Dateiname
Workbooks(Dateiname).Sheets("Quellsheet").Range("C18:TF27").Copy
Reihe = ThisWorkbook.Sheets("Zielsheet").Range("E65536").End(xlUp).Offset(1, 0).Row
ThisWorkbook.Sheets("Zielsheet").Cells(Reihe, 5).PasteSpecial Paste:=xlPasteValues, Operation:=  _
_
xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Workbooks(Dateiname).Close SaveChanges:=False
Application.DisplayAlerts = True
Dateiname = Dir()
Loop
End Sub

Mein Ziel ist es die Range("C18:TF27") so zu gestalten, dass er mir lediglich die Reihen in diesem Bereich kopiert die gefüllt sind. In der Spalte C ist immer ein Kürzel aus mehreren Buchstaben enthalten (vielleicht hilft das für den Anfang If "" Then).
Leider konnte ich mit meinen Kenntnissen durch langes rumprobieren keine Lösung finden, weshalb ich nun auf eure Hilfe angewiesen bin.

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ein Versuch
13.12.2017 19:43:39
Phi
@Ralf
sofern unter den zu kopierenden Daten keine weiteren Zeilen kommen, könnte das passen:

Sub Ursprüngliches_Makro()
Dim Pfad As String, Dateiname As String, Reihe As Long
dim WBQ as workbook '##
Application.ScreenUpdating = False
Pfad = “Beispielpfad….”
Dateiname = Dir(Pfad & "*.xls")
Do While Dateiname  ""
set WBQ = Workbooks.Open Filename:=Pfad & Dateiname
with WBQ.sheets("Quellsheet")
lr = .cells(rows.count, 3).end(xlup).row
.Range("C18:TF" & lr).Copy
Reihe = ThisWorkbook.Sheets("Zielsheet").Range("E65536").End(xlUp).Offset(1, 0).Row
ThisWorkbook.Sheets("Zielsheet").Cells(Reihe, 5).PasteSpecial Paste:=xlPasteValues, Operation:=  _
_
_
xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
WBQ.Close SaveChanges:=False
end with
Application.DisplayAlerts = True
Dateiname = Dir()
Loop
End Sub

Anzeige
AW: ein Versuch
14.12.2017 12:45:38
Ralf
Leider sind unter dem relevanten Bereich noch Zeilen die mitkopiert werden müssen.
Dennoch danke für deine Hilfe!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige