Felder in aktives Sheet kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Mathias,
teste mal.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importMaterial()
Dim objWB As Workbook, objWS As Worksheet, objActive As Worksheet, rng As Range
Dim strFile As String

On Error GoTo ErrExit

Static CalculationMode As Long

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  CalculationMode = .Calculation
  .Calculation = xlManual
  .DisplayAlerts = False
End With

On Error Resume Next
Set rng = Application.InputBox("Wo sollen die Daten eingefügt werden?", _
  "Materialliste", ActiveCell.Address, Type:=8)
On Error GoTo ErrExit

If Not rng Is Nothing Then
  rng.CurrentRegion.Clear
  
  With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = "E:\Forum"
    .Title = "Datei auswählen"
    .ButtonName = "Auswahl..."
    .InitialView = msoFileDialogViewList
    .Filters.Clear
    .Filters.Add "Excel Dateien", "*.xls; *.xlsx; *.xlsm", 1
    .Filters.Add "Alle Dateien", "*.*", 2
    .FilterIndex = 1
    If .Show = -1 Then strFile = .SelectedItems(1)
  End With
  
  If Len(strFile) Then
    Set objWB = Workbooks.Open(strFile)
    objWB.Sheets(1).Copy Before:=rng.Parent
    objWB.Close False
    Set objWS = ThisWorkbook.Sheets(rng.Parent.Index - 1)
    With objWS
      .Range("A1").AutoFilter Field:=14, Criteria1:="=x", Operator:=xlAnd
      .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy rng
      .Delete
    End With
    rng.Range("C1,D1,H1:N1").EntireColumn.Delete
  End If
End If

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'importMaterial'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - importMaterial"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = CalculationMode
  .DisplayAlerts = True
  .StatusBar = False
End With


Set rng = Nothing
Set objWB = Nothing
Set objWS = Nothing
Set objActive = Nothing
End Sub

Gruß Sepp

Hallo Sepp,
vielen vielen Dank erst einmal für das Makro und deine Mühe.
Leider macht das Makro noch nicht so ganz das, was ich mir vorgestellt habe. Grund ist wohl auch, dass ich dir zu wenige Informationen gegeben habe ;)
Ich habe mal die beiden betroffenen Dateien angehangen. Zum einen die Materialliste - diese liegt immer bei mir unter C:\temp\Materialliste.xlsx.
Dann meine Vorlagendatei - hier mit dem Namen "Materialverbrauch". Diese kann auch anders heißen.
In der Datei Materialverbrauch sind u.a. Zellen enthalten, die mit Formeln oder auch einem sverweis gefüllt sind. Diese werden beim ausführen von deinem Makro leider gelöscht.
Ich habe heute noch ein paar kleine Anpassungen an der Materialliste vornehmen müssen, so dass jetzt folgende Felder aus der Materialliste in die Tabelle Materialverbrauch kopiert werden müssten:
A nach A
C nach D
D nach E
F nach G
I nach J
Die Tabelle Materialliste habe ich eigentlich immer geöffnet. Von daher könnte das Makro die Daten direkt aus dieser Datei holen.
Ist das viel Aufwand, dein Makro nach meinen Vorstellungen anzupassen?
https://www.herber.de/bbs/user/100605.xlsx
https://www.herber.de/bbs/user/100606.xlsx
Viele Grüße
Mathias

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Felder in aktives Sheet kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread