|
Hallo Zusammen,
Seite 2 Stunden versuche ich mein Problem zu lösen aber kriege ich die Lösung nicht hin. Ich kopiere von einem Datei Daten und füge ich einem excel arbeitsblatt oberhalbe 3 leer Zeile. (Siehe Anhang). Ich gehe wie folgendes ich füge oberhalb diese leere Zeile weitere leere Zeile (Die Anzahl der Zeile muss mit die Anzahl der kopierte Zelle übereistimmen), und verwende dabei die for loop. Es funktioniert super für die kleine Datenmenge. Bei großere Datenmenge dauert es zu lang.
Aber ohne Loop gehts es ja auch schneller abre die leer zeile unten werden gelöscht (Was ich nicht wollte.)
Frage. Gibt es alternative und effiziente Lösung dazu?
Wie kann ich kopierte Zelle oberhalb bestimmte Zelle einfugen ?
Danke für Ihren Vorschläge.
Hier meine aktuelle Code:
Sub DataImport()
Dim Customerworkbook As Workbook, MyWorkbook As Workbook
Dim customerFilename As Variant
Dim Pathname As String
Dim FileName As String
Dim LastRow_Cust As Integer
Dim LastRow_Wb As Integer
Application.ScreenUpdating = False
'Set MyWorkbook as active Book
Set MyWorkbook = Application.ActiveWorkbook
LastRow_Wb = Worksheets(2).Range("A2").CurrentRegion.Rows.Count
' Set the path to the folder that you want to open.
MyPath = "C:\Users\HerveBigSmall2013\Desktop\9324920011"
' Change drive/directory to MyPath.
ChDrive MyPath
ChDir MyPath
FileName = Application.GetOpenFilename(FileFilter:="Text Files (*.asc),*.asc")
'Open the specific File containing Data to edit
Workbooks.OpenText FileName:=sPath & FileName, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=False, Space:=False, Other:=True, OtherChar:=";", Local:=True
Set Customerworkbook = Application.ActiveWorkbook
LastRow_Cust = Worksheets(1).Range("A2").CurrentRegion.Rows.Count
For i = 1 To LastRow_Cust
MyWorkbook.Sheets(2).Rows(LastRow_Wb + 1 & ":" & LastRow_Wb + 1).Insert Shift:=xlDown
Next i
Customerworkbook.Worksheets(1).Range("A2" & ":AAW" & LastRow_Cust).Copy Destination:=MyWorkbook.Sheets(2).Range("A" & LastRow_Wb + 1 & ":AAW" & LastRow_Wb + 1).Cells
End Sub
Ich kann leider kein Datei einfügen
Ich freue mich auf Ihre Vorschäge
Grüße
Baggio
|