Problem mit SpecialPaste
07.08.2019 15:53:49
Milli
ich habe eigentlich eine einfache Aufgabe über ein Makro gelöst. Das Makro fragt nach einem Speicherort für Exceldateien, öffnet diese und kopiert die Daten aus einem bestimmten Bereich in einer Hauptdatei zusammen. Anzahl der Excel-Dateien und Menge der Daten variiert.
Das Makro funktioniert so weit so gut.
************
Option Explicit
Private Sub CommandButton1_Click()
Dim oFolder As Object 'Ordner für die Schleife
Dim oFile As Object 'Datei für die Schleife
Dim wbQuelle As Workbook 'Die Dateien die durch die Schleife laufen, werden als _
Datei definiert
Dim Zieldatei As Workbook 'Das ist Flächenbilanz, in welcher die Daten _
verarbeitet werden
Dim sPath As String 'Welcher Pfad soll ausgelesen werden
Dim oFSO As Object 'Variable zum Öffnen der Auswahl Explorer
Dim letzte_zeile As Integer 'Die letzte Zeile in der Zieldatei für das Einfügen _
neuer Daten
Dim Dateiname As String, i As Integer 'Auflistung der Dateinamen, welche ausgelesen werden
' Automatische Abfragen von Excel deaktivieren
Application.DisplayAlerts = False
'Falls bereits Daten eingelesen wurden, müssen diese vor dem erneuten Import gelöscht werden
Sheets("Rohdaten").Range("A3:BP100000").ClearContents
'Auswahl des Ordner, in welchem die Dateien liegen, die nacheinander geöffnet und ausgelesen _
werden
'!Das ist spath!
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
sPath = .SelectedItems(1)
If Right(sPath, 1) "\" Then sPath = sPath & "\"
Else
sPath = ""
End If
End With
If sPath = "" Then
'MsgBox ("Kein Ordner gewählt!")
Else
Range("AQ5").Value = sPath
End If
Range("AQ6").Select
'Auflistung der Dateinamen in einem bestimmten Ordner ab der aktiven Zelle
'!Das ist Dateiname!
Dateiname = Dir$(sPath) 'Alternativ: Hier Verzeichnis und Datei angeben (Dir$("c:\*.*"))
Do While Dateiname ""
ActiveCell.Offset(i, 0) = Dateiname
i = i + 1
Dateiname = Dir$()
Loop
'Definitionen für die Schleife
Set Zieldatei = ActiveWorkbook
Set oFSO = CreateObject("scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
'Beginn der Schleife
For Each oFile In oFolder.Files 'Jede Datei im ausgewä _
hlten Ordner
Set wbQuelle = Workbooks.Open(oFile.Path) 'Definiere die Quelle
With wbQuelle.Sheets("Raw data export for spaces (Roh") 'Tabelle in der Quelle
.Range("A3:BP3").Select 'Bereich in der Quelle
.Range(Selection, Selection.End(xlDown)).Copy 'Kopieren
wbQuelle.Close savechanges:=False 'Datei schließen ohne _
Speichern
End With
Zieldatei.Sheets("Rohdaten").Activate 'Zieldatei öffnen
With Zieldatei.Sheets("Rohdaten") 'Zieltabelle auswählen
letzte_zeile = ActiveSheet.Cells(1048576, 1).End(xlUp).Row 'letzte Zeile der _
Tabelle
.Range("A" & letzte_zeile + 1).PasteSpecial 'Einfügen
End With
'Ende der ersten Schleife bzw. Wiederholung der Schleife
Next oFile
' Automatische Abfragen von Excel aktivieren
Application.DisplayAlerts = True
Dim zelle As Range
With Zieldatei.Sheets("Rohdaten") 'Zieltabelle auswählen
.Range("AE3").Select
.Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
For Each zelle In Selection
zelle.Value = 1 * zelle.Value
Next
End With
Zieldatei.Sheets("Grunddaten").Activate
MsgBox ("Die Daten wurden eingelesen!")
End Sub
**********Nun gibt es aber ein Problem: In den Exceldateien sind Spalten (z. B. AC bis AF) mit unterschiedlichen Nachkommastellen. Wenn die Daten importiert werden, werden die Nachkommastellen gekürzt. Das darf natürlich nicht passieren.
Kann mir jemand helfen?
Viele Grüße
Janet
https://www.herber.de/bbs/user/131317.zip