Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1804to1808
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

Befehl für Datenübertragung

Befehl für Datenübertragung
19.01.2021 15:39:29
Ramadani
Hallo allerseits
Ich versuche anhand eines VBA Befehls/ Makros eine immer wiederkehrende Tätigkeit zu automatisieren.
Dabei geht es darum die Daten einer Excel Datei, welche sich in einem Ordner befindet, bearbeitet in die aktuelle Mappe zu kopieren. Der Befehl sieht bisher so aus;
Sub Test()
' Test Makro
Application.WindowState = xlNormal
Windows("Produktionen-2020_12.xlsx").Activate
Cells.Select
Selection.Copy
Windows("Mappe1").Activate
Cells.Select
ActiveSheet.Paste
Columns("Q:BA").Select
Application.CutCopyMode = False
Selection.Clear
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("O:O,M:M").Select
Range("M1").Activate
Selection.EntireColumn.Hidden = True
Columns("A:P").Select
Selection.AutoFilter
Range("B1").Select
ActiveSheet.Range("$A$1:$P$15855").AutoFilter Field:=2, Criteria1:=Array( _
"1", "2", "3", "32", "33", "34", "35", "4", "5"), Operator:=xlFilterValues
End Sub
So wie der Befehl aktuell ist wählt er immer nur Mappe 1 aus und nur die offene Datei. Die "fett" markierten Befehle müssten auf einen Ordner bezogen werden und die aktive Mappe. Kann mir bitte jemand weiter helfen?

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Befehl für Datenübertragung
19.01.2021 18:24:47
fcs
Hallo Ramadani,
wenn du für die Quelle einen Ordner mit einbinden willst, dann musst die Quelle in einem Dateidialog geöffnet werden oder der komplette Pfad musst fest im Code vorgegeben werden und die Datei dann geöffnet werden.
LG
Franz
Sub Test()
' Test Makro
Dim wkbAktiv As Workbook, wksAktiv As Worksheet
Dim wkbQuelle As Workbook, varQuelle As Variant
Set wkbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte zu importierende Datei auswählen"
.FilterIndex = 2 'Exceldateien
If .Show = -1 Then
varQuelle = .SelectedItems(1)
Else
Exit Sub
End If
End With
Set wkbQuelle = Application.Workbooks.Open(varQuelle, ReadOnly:=True)
wkbQuelle.Worksheets(1).Cells.Copy
wkbAktiv.Activate
With wksAktiv
.Cells.PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
.Range("Q:BA").Delete
.UsedRange.AutoFilter
.Range("O:O,M:M").EntireColumn.Hidden = True
.Range("B1").Select
.UsedRange.AutoFilter Field:=2, Criteria1:=Array( _
"1", "2", "3", "32", "33", "34", "35", "4", "5"), Operator:=xlFilterValues
End With
wkbQuelle.Close savechanges:=False 'Quelldatei wieder schliessen
End Sub

Variante
Sub Test_2()
' Test Makro
Dim wkbAktiv As Workbook, wksAktiv As Worksheet
Dim wkbQuelle As Workbook, varQuelle As Variant
Set wkbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
varQuelle = "C:\Users\Public\Test\Produktionen-2020_12.xlsx"
Set wkbQuelle = Application.Workbooks.Open(varQuelle, ReadOnly:=True)
wkbQuelle.Worksheets(1).Cells.Copy
wkbAktiv.Activate
With wksAktiv
.Cells.PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
.Range("Q:BA").Delete
.UsedRange.AutoFilter
.Range("O:O,M:M").EntireColumn.Hidden = True
.Range("B1").Select
.UsedRange.AutoFilter Field:=2, Criteria1:=Array( _
"1", "2", "3", "32", "33", "34", "35", "4", "5"), Operator:=xlFilterValues
End With
wkbQuelle.Close savechanges:=False 'Quelldatei wieder schliessen
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige