|
Hey Leute,
ich habe ein kleines Problem und komme nicht weiter. Ich schreibe gerade ein Makro um, welches ich in einem anderen Forum gefunden habe. Ich habe alle Daten angepasst, dennoch tut sich nach der Ausführung des Makros nichts, keine Fehleranzeige und keine sonstige Ausgabe. Nachfolgend füge ich meinen Code ein (1) und anschließend den Original Code (2)
Mein Code (1)
Dim Pfad As String
Dim Dateiname As String
Dim iCol As Long
Dim PfadOrg As String
Dim DateinameOrg As String
Dim SourceRange As Range
Dim DestinationRange As Range
Pfad = "C:\"
PfadOrg = "C:\\"
DateinameOrg = Dir(PfadOrg & "Zieldatei.xlsm")
Dateiname = Dir$(Pfad & "*.xlsm")
While Len(Dateiname)
Workbooks.Open Filename:=Pfad & Dateiname
iCol = Workbooks(DateinameOrg).Sheets("TabelleInDerZieldatei").Range("A1").End(xlToLeft).Offset(0, 1).Column
Set SourceRange = Workbooks(Dateiname).Sheets("TabelleInDerQuelldatei").Range("A1:BD877")
Set DestinationRange = Workbooks(DateinameOrg).Sheets("TabelleInDerZieldatei").Cells(1, iCol).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
DestinationRange.Value = SourceRange.Value
Application.DisplayAlerts = False
Workbooks(Dateiname).Close SaveChanges:=False
Dateiname = Dir$
Wend
Application.DisplayAlerts = True
End Sub
.-.-.-.-.-..--.-.-.-.-..-.-..-..-.-.-.-.-.-.-.-.-..--.-.-.-.-..-.-..-..-.-.-.-.-.-.-.-.-..--.-.-.-.-..-.-..-..-.-.-.-.-.-.-.-.-..--.-.-.-.-..-.-..-..-.-.-.-.-.-.-.-.-..--.-.-.-.-..-.-..-..-.-.-.-.-.-.-.-.-..--.-.-.-.-..-.-..-..-.-.-.-
VB.NET-Quellcode (2)
-
Sub Daten_kopieren()
-
-
Dim Pfad As String, Dateiname As String, iCol As Long
-
Dim PfadOrg As String, DateinameOrg As String
-
Dim SourceRange As Range, DestinationRange As Range
-
-
-
-
Pfad = "U:\Projekte\Erstverladungen\"
-
-
PfadOrg = "U:\Projekte\"
-
DateinameOrg = Dir(PfadOrg & "Erstverladungen.xlsm")
-
-
Dateiname = Dir$(Pfad & "*.xlsm")
-
-
While Len(Dateiname)
-
-
Workbooks.Open Filename:=Pfad & Dateiname
-
-
-
-
-
iCol = Workbooks(DateinameOrg).Sheets("Tabelle1").Range("XFD2").End(xlToLeft).Offset(0, 1).Column
-
-
-
-
Set SourceRange = Workbooks(Dateiname).Sheets("Verladeliste-Rohbau").Range("P16:P683")
-
Set DestinationRange = Workbooks(DateinameOrg).Sheets("Tabelle1").Cells(2, iCol).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
-
DestinationRange.Value = SourceRange.Value
-
-
Application.DisplayAlerts = False
-
Workbooks(Dateiname).Close SaveChanges:=False
-
Dateiname = Dir$
-
-
Wend
-
-
Application.DisplayAlerts = True
-
End Sub
|