Daten import?

Computer: Software & Programmierung Office Software
#1

Hallo
Ich habe ein Makro mit dem ich daten importieren möchte.
Das aufrufen der Quelldatei(en) und Kopieren der Daten klappt.
Nur fügt es die Daten nicht in die Zieldaten ein. Das Makro steht in der Zieldatei.
Code:
Sub Daten_Import()
Application.EnableEvents = False

Dim strPath As String
strExt = "*.xls"       'Dateiextension ggf. anpassen
Dim strFile As String

 Dim oFileDialog As FileDialog

Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With oFileDialog
.Title = „Wählen Sie bitte den gewünschten Ordner aus!“
.ButtonName = „Übernehmen“
.InitialFileName = „T:\NM_Public\HFCP\10 SCANPET\01_Daten Konsolidierung\01_Eingang“
If .Show = True Then
strPath = .SelectedItems(1) & „“
Else: Exit Sub

End If
End With
'strPath = " Cells(1, 1).Value & Cells(1, 2).Value & Cells(1, 3).Value & Cells(1, 4).Value"
'strPath = UserForm1.TextBox1.Text & „“

If strPath = "" Then
    Exit Sub
Else
    strFile = Dir(strPath & strExt)
    Do While Len(strFile) > 0
        Workbooks.Open Filename:=strPath & strFile
        'UserForm.showmodal = False

'QUELLDATEI
ActiveWorkbook.Sheets(„BYB“).Cells(2, 1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy

'ZIELDATEI
 FreieZeile = ThisWorkbook.Sheets("alle erfassten").Cells(Rows.Count, 20).End(xlUp).Row + 1

ThisWorkbook.Sheets(„alle erfassten“).Cells(FreieZeile, 1).Value = ActiveSheet.Paste
'Call keine_MAC

Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.EnableEvents = True

        '...
        'ActiveWorkbook.Close
        strFile = Dir() ' nächste Datei
    Loop
End If

       'ActiveWorkbook.Save
       'Application.Quit

End Sub

Gruss

Walti

#2

Grüezi Walti

Ich bin nicht sicher, aber Ich glaube, in Deinem Makro wird und bleibt die Quelldatei die aktive Datei. Irgendwann musst Du wieder zu Deiner Zieldatei zurückkehren. Versuche es doch mit folgender Ergänzung und Aenderung. „NameZieldatei.xls“ musst Du mit dem Namen Deiner Zieldatei ersetzen.

'ZIELDATEI
Windows("NameZieldatei.xls").Activate
freiezeile = ActiveWorkbook.Sheets("alle erfassten").Cells(Rows.Count, 20).End(xlUp).Row + 1
usw.

Ich hoffe, das hilft Dir.
Grüsse Niclaus

#3

kleiner Hinweis: Bei Einfuegen von hand muss eine Anfangszelle genannt werden, ab der eingefuegt wird.

#4

Ich habe den Fehler gefunden:
Sub Daten_Import()
Application.EnableEvents = False

Dim strPath As String
strExt = "*.xls"       'Dateiextension ggf. anpassen
Dim strFile As String

 Dim oFileDialog As FileDialog

Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With oFileDialog
.Title = „Wählen Sie bitte den gewünschten Ordner aus!“
.ButtonName = „Übernehmen“
.InitialFileName = „T:\NM_Public\HFCP\10 SCANPET\01_Daten Konsolidierung\01_Eingang“
If .Show = True Then
strPath = .SelectedItems(1) & „“
Else: Exit Sub

End If
End With
'strPath = " Cells(1, 1).Value & Cells(1, 2).Value & Cells(1, 3).Value & Cells(1, 4).Value"
'strPath = UserForm1.TextBox1.Text & „“

If strPath = "" Then
    Exit Sub
Else
    strFile = Dir(strPath & strExt)
    Do While Len(strFile) > 0
        Workbooks.Open Filename:=strPath & strFile
        'UserForm.showmodal = False

'QUELLDATEI
ActiveWorkbook.Sheets(„BYB“).Cells(2, 1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

'ZIELDATEI
 FreieZeile = ThisWorkbook.Sheets("alle erfassten").Cells(Rows.Count, 20).End(xlUp).Row + 1

ThisWorkbook.Sheets(„alle erfassten“).Cells(FreieZeile, 1**).Select**
ActiveSheet.Paste
Call keine_MAC

Application.EnableEvents = True

        '...
        'ActiveWorkbook.Close
        strFile = Dir() ' nächste Datei
    Loop
End If

       'ActiveWorkbook.Save
       'Application.Quit

End Sub
siehe Fett

Gruss

Walti