Thema Datum  Von Nutzer Rating
Antwort
Rot Copierte Zelle Eifügen
 21.10.2016 22:02:02 Baggio
NotSolved

Ansicht des Beitrags:
Von:
Baggio		 Datum:
21.10.2016 22:02:02		 Views:
1282		 Rating:
     
Antwort:
  Ja
Thema:
Copierte Zelle Eifügen

 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:
 
 
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Copierte Zelle Eifügen
 21.10.2016 22:02:02 Baggio
NotSolved