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

Import Excel nach Excel

Import Excel nach Excel
06.02.2017 13:46:38
Sanja
Hallo,
ich habe folgenden Code mit dem ich Daten aus einen Excel-Datei in eine andere Excel-Datei importiere. Leider fügt er alle ein, aber ich möchte nur dass er die Werte übernimmt. Ich habe es mit Paste Special probiert, aber bekomme immer die Meldung, das die Range Methode nicht ausgeführt werden kann. Anscheinend mache ich etwas in der Syntax falsch, weiß aber nicht was?
Ich habe den betreffenden Bereich im Code mit ########## markiert.
Kann mir jemand weiterhelfen?
Vielen Dank im Voraus!!!!
Anja
Private Sub cmdImport_Click()
On Error Resume Next
'ActiveSheet.ShowAllData
'ActiveSheet.Range("A16:S30000").EntireRow.Hidden = False
'ActiveSheet.Range("A16:S30000").FormatConditions.Delete
On Error GoTo errExit
Dim wbQuelle As Workbook, Quelle As Worksheet, Ziel As Worksheet
Dim Datei As Variant, varDateien
Dim Zeile_Z As Long, Zeile_S1 As Long, Zeile_S2 As Long
Dim rngZelle As Range
Dim lngAnzahl As Long
Dim lngLastQ As Long
On Error GoTo Fehler
'Dialog "Datei öffnen" anzeigen
varDateien = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm", _
Title:="Bitte zu importieren Datei(en) auswählen", MultiSelect:=True)
'  For lngAnzahl = LBound(varDateien) To UBound(varDateien)
'Abbrechen falls keine Datei ausgewählt
If Not IsArray(varDateien) Then
MsgBox "keine Datei ausgewählt", , "Abbruch"
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'  Inhalt Zeilen löschen
ThisWorkbook.Worksheets("Test").Range("A16:S20000").ClearContents
'  Worksheets("Test").Range("A16:T20000").entirerows
'  Zieldatei
Set Ziel = ThisWorkbook.Worksheets("Test")
With Ziel
'Startzeile setzen
Set rngZelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
Zeile_Z = 14
Else
Zeile_Z = rngZelle.Row
End If
If Zeile_Z = Zeile_S1 Then
'kopieren und einfügen
'  '      .Range(.Rows(Zeile_S1), .Rows(Zeile_S2)).Copy Ziel.Cells(Zeile_Z, 1)
'   ############# Bisher verwendeter Code ##########################
'          .Range(.Cells(Zeile_S1, 1), .Cells(Zeile_S2, 39)).Copy Ziel.Cells(Zeile_Z, 1)
'   ############# Mein neuer Code, mit der Fehlermeldung ##########################
.Range(.Cells(Zeile_S1, 1), .Cells(Zeile_S2, 39)).Copy Ziel
.Cells(Zeile_Z, 1).PasteSpecial xlPasteValues
'nächste Einfügezeile
Zeile_Z = Zeile_Z + Zeile_S2 - Zeile_S1 + 1
End If
End With
'Sheets("Gläubigerdaten").Rows("13:2000").Copy
'    Sheets("Gläubigerdaten").Rows("13:2000").PasteSpecial xlPasteValues
NextDatei:
wbQuelle.Close savechanges:=False
'Speicher freigeben
Set Quelle = Nothing
Set wbQuelle = Nothing
Next Datei
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
If Not wbQuelle Is Nothing Then wbQuelle.Close savechanges:=False
MsgBox "FehlerNr.: " & .Number & vbNewLine & vbNewLine _
& "Beschreibung: " & .Description, _
vbCritical, "Fehler"
End Select
End With
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
'Speicher freigeben
Set Quelle = Nothing
Set wbQuelle = Nothing
Set Ziel = Nothing
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
MsgBox "Es werden " & UBound(varDateien) & " Dateien eingefügt.", 64
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
'  Call Makro_Sortieren
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Import Excel nach Excel
06.02.2017 14:19:52
Michael
Hi,
nicht
.Range(.Cells(Zeile_S1, 1), .Cells(Zeile_S2, 39)).Copy Ziel
.Cells(Zeile_Z, 1).PasteSpecial xlPasteValues

sondern
.Range(.Cells(Zeile_S1, 1), .Cells(Zeile_S2, 39)).Copy
Ziel.Cells(Zeile_Z, 1).PasteSpecial xlPasteValues
Gruß,
Michael
AW: Import Excel nach Excel
06.02.2017 19:28:03
Sanja
Hallo Micheal,
so einfach kann es sein....
Vielen Dank. Klappt super!!!
Gruß
Anja
gern geschehen, Gruß zurück owT
11.02.2017 14:15:05
Michael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige