Bestimte Daten aus eine andere Excel importieren !
13.12.2016 11:22:45
Pramkies
Ziel: ich möchte gerne aus eine Excel liste "Stückliste" bestimmte Felder aus zu bestimmten Werten in eine neue Excel liste und auch in bestimte Felder importieren. Und das so schnell wie möglich!!!
Stand: Die Stückliste wird über Application.GetOpenFilename() ausgewählt!
Somit Bestimme die Anzahl der Zeilen die ich Importieren möchte, um mit For-Schleife das Copieren zu realisieren. Ich möchte nicht alle spalten Importieren, sondern bestimmte Spalten! Auch nur als Wert ( keine Faormartierung) ! Es funktioniert auch alles, aber es dauert mir einfach zu lange ! in der Stückliste habe ich bis zu 10.000 Zeilen!! Wenn ich mein Makro starte, habe ich immer dieses aufblitzen !
VBA-Code
Sub Stueckliste_Einlesen_Temp()
' Stückliste einlesen
' Erstellt von XXXXX 06.12.2016
Dim Stamm As String
Dim Quelldatei As Variant
Dim i As Long, tmp
Dim Zeile As Long
Dim Zeilebegin As Long
Dim Spalte As Long
Dim zeilemax As Long
Dim varDatei As Variant ' Stückliste
Dim QSheet As String
Dim ZSheet As String
Dim MsgText As String
varDatei = Application.GetOpenFilename()
If varDatei = False Then
MsgBox "Der Benutzer hat abgebrochen.", vbInformation
Exit Sub
Else
MsgBox "Folgende Datei wurde ausgewählt:" & vbCrLf & varDatei
'MsgBox vbCrLf
'MsgBox varDatei
End If
'QSheet = Cells(2, 18).Value ' Fest Zuordnung
'MsgBox QSheet
Stamm = ActiveWorkbook.Name ' ist die Zieldatei
'Quelldatei = "P-XXXXXX_Stückliste" 'Dateiname anpassen
'Workbooks.Open Filename:="E:\XXXXXXX\" & Quelldatei 'Ablageort der Quelldatei anpassen
Workbooks.Open Filename:=varDatei 'Ablageort der Quelldatei anpassen
Quelldatei = ActiveWorkbook.Name 'Dateiname anpassen
'MsgBox Quelldatei
QSheet = ActiveSheet.Name
MsgBox QSheet
zeilemax = Workbooks(Quelldatei).Sheets(QSheet).Cells(Rows.Count, 1).End(xlUp).Row '[Ermitteln _
_
der Zeilenanzahl in Tabelle 1]
ZSheet = "Temp"
MsgBox zeilemax
Zeile = Workbooks(Stamm).Sheets(ZSheet).Cells(Rows.Count, 1).End(xlUp).Row '[Ermitteln der _
Zeilenanzahl in Tabelle 2]
'MsgBox Zeile
Zeilebegin = 4
For Zeile = 1 To zeilemax
If Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 65).Value = "Ja" And Workbooks(Quelldatei). _
_
Sheets(QSheet).Cells(Zeile, 17).Value = "TT" Then '[Abfrage ob Doku = Ja && Messfunktion = _
TT
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 70).Copy
Destination: Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 1).PasteSpecial Paste:= _
xlPasteValues
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 1).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 2).PasteSpecial Paste:=xlPasteValues ' _
Bereich
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 3).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 3).PasteSpecial Paste:=xlPasteValues 'BMK
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 23).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 4).PasteSpecial Paste:=xlPasteValues 'Doku- _
Hersteller/ Lieferant
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 66).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 5).PasteSpecial Paste:=xlPasteValues 'Doku- _
Bezeichnung/ Bennenung
'Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 10).Copy
'Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 5).PasteSpecial Paste:=xlPasteValues 'Doku- _
_
Typ
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 7).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 6).PasteSpecial Paste:=xlPasteValues 'Doku- _
Artikel-Typ
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 14).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 7).PasteSpecial Paste:=xlPasteValues 'Meß _
bereich
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 12).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 8).PasteSpecial Paste:=xlPasteValues ' _
Nennweite
Workbooks(Quelldatei).Sheets(QSheet).Cells(Zeile, 24).Copy
Workbooks(Stamm).Sheets(ZSheet).Cells(Zeilebegin, 9).PasteSpecial Paste:=xlPasteValues 'Komp. _
_
SAP-Nr.
Zeilebegin = Zeilebegin + 1
End If
Next Zeile
'xlPasteValues ' Blatt/Bereich anpassen
'Application.CutCopyMode = False
Workbooks(Quelldatei).Close
MsgText = "Stückliste eingelesen!"
MsgBox MsgText
End Sub