Datei auswählen, bestimmten Bereich einf

Hallo liebe Community,
ich sitze jetzt schon länger an dem Problem und komme einfach nicht weiter.
Ich möchte über einen picker eine Datei auswählen und bei dieser nach Kriterien filtern, einen bestimmten Bereich kopieren und in die aktive Liste untendrunter einfügen. Ich verstehe nicht wo es hieran scheitert.
Hat jemand eine Antwort parat?
Ich bedanke mich im Voraus!
Mit freundlichen Grüßen
Maxi
------------------------------------------------------------------------------------------------ _
------------------------------------------------


Sub AutoImport1()
Application.ScreenUpdating = False
Sheets("Archiv").Select
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
Dim ErsteLeerzeile As Long
ErsteLeerzeile = Sheets("Archiv").Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim strDatei As String
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "xyz"
.Title = "Bitte Datei auswählen"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then
strDatei = .SelectedItems(1)
Else
Exit Sub
End If
End With
Workbooks.Open Filename:=strDatei
Dim ImportDateiName As String
ImportDateiName = ActiveWorkbook.Name
Sheets("Maßnahmenliste").Activate
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
ActiveSheet.Range("$K$3:$K$" & Cells(Rows.Count, 1).End(xlUp).Row & ",$M$3:$M$" & Cells( _
Rows.Count, 1).End(xlUp).Row & ",$R$3:$R$" & Cells(Rows.Count, 1).End(xlUp).Row & ",$AM$3:$AM$"  _
_
_
_
_
_
& Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=1, Criteria1:="=F"
ActiveSheet.Range("$K$3:$K$" & Cells(Rows.Count, 1).End(xlUp).Row & ",$M$3:$M$" & Cells( _
Rows.Count, 1).End(xlUp).Row & ",$R$3:$R$" & Cells(Rows.Count, 1).End(xlUp).Row & ",$AM$3:$AM$"  _
_
_
_
_
_
& Cells(Rows.Count, 1).End(xlUp).Row).Copy
Windows(ThisWorkbook.Name).Activate
Range("A" & ErsteLeerzeile).PasteSpecial Paste:=xlPasteValues
Windows(ImportDateiName).Close savechanges:=False
End Sub

-------------------------------------------------------------------------------------------------------------------------------

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub AutoImport1() Dim ErsteLeerzeile As Long Dim strDatei As String Dim wkbZiel As Workbook, wksZiel As Worksheet, Zei_QL As Long Dim wkbQuelle As Workbook, wksQuelle As Worksheet Application.ScreenUpdating = False Set wksZiel = ThisWorkbook.Sheets("Archiv") With wksZiel .Select If .FilterMode Then .ShowAllData ErsteLeerzeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 End With With Application.FileDialog(msoFileDialogFilePicker) .InitialFileName = "xyz" .Title = "Bitte Datei auswählen" .ButtonName = "Auswahl..." .InitialView = msoFileDialogViewDetails If .Show = -1 Then strDatei = .SelectedItems(1) Else Exit Sub End If End With Set wkbQuelle = Workbooks.Open(Filename:=strDatei, ReadOnly:=True) Set wksQuelle = wkbQuelle.Worksheets("Maßnahmenliste") With wksQuelle If .FilterMode Then .ShowAllData Zei_QL = .Cells(Rows.Count, 1).End(xlUp).Row .Range("$K$3:$AM$" & Zei_QL).AutoFilter Field:=1, Criteria1:="F" .Range("$K$4:$K$" & Zei_QL & ",$M$4:$M$" & Zei_QL & ",$R$4:$R$" & Zei_QL _ & ",$AM$4:$AM$" & Zei_QL).Copy End With ThisWorkbook.Activate wksZiel.Range("A" & ErsteLeerzeile).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False wkbQuelle.Close savechanges:=False End Sub

Beliebteste Forumthreads (12 Monate)

Datei auswählen, bestimmten Bereich einf

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread