Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Zeile mittels VBA in EXCEL ausschneiden und in anderem Tabellenblatt einfügen

Frage Microsoft Microsoft Office

Mitglied: Petralein

Petralein (Level 1) - Jetzt verbinden

18.05.2010, aktualisiert 19.05.2010, 9123 Aufrufe, 3 Kommentare

Hallo
bin in der Ausbildung und habe gleich einen für mich schwierigen Auftrag von meinem Ausbilder bekommen.
Hoffe daher auf Eure Hilfe.

Zum Problem:

Excel-Tabelle (Vers. 2003) mit dem Blatt Lager und dem Blatt Bestellen.

Man kann über eine Userform das Blatt Lager durchsuchen und der Datensatz
wird dann in den Textboxen angezeigt.

Findet die Suchfunktion etwas und man klickt es an, wird beispielsweise der
Inhalt der Zelle A5 in Textbox1, B5 in Textbox2, C5 in Textbox3 usw. angzeigt.

Bis dahin funktioniert alles.

Nun möchte mein Ausbilder dass der angezeigte Datensatz aus dem
Tabellenblatt Lager ausgeschnitten und im Tabellenblatt Bestellen
an letzter Stelle eingefügt wird.

Ich habe mir das alles zusammenkopiert und durch probieren bis hierhin geschafft.

Leider komme ich nicht weiter.

Es wäre schön wenn mir jemnd helfen könnte.

Danke
Petra
Mitglied: dog
18.05.2010 um 20:59 Uhr
Ich habe mir das alles zusammenkopiert und durch probieren bis hierhin geschafft.

Leider komme ich nicht weiter.

Ähm....ja?
Bitte warten ..
Mitglied: TheEternalPhenom
19.05.2010 um 10:47 Uhr
Hallo Petralein

Was genau funktioniert nicht?

Eine etwas genauere Fehlerbeschreibung wäre gut.

Am besten du zeigst uns mal deinen Code und beschreibst was genau noch fehlt bzw. nicht funktioniert.

Gruß

duffman521
Bitte warten ..
Mitglied: Petralein
19.05.2010 um 20:05 Uhr
Hallo,
der beigefügte Code macht schon fast das was ich will.
Er schneidet die Zeile aus und kopiert sie in eine neue Tabelle.

Ich möchte jedoch das die Zeile in die Tabelle BESTELLEN kopiert wird.

Der CommanButton4 schneidet aus und kopiert in eine neue Tabelle.

Hier der gesamte Code:
01.
Option Explicit 
02.
Dim wks As Worksheet 
03.
Dim wkb1, wkb2 As Workbook 
04.
Dim XBlatt, wks2 As Worksheet 
05.
Dim XZeile As Long 
06.
Dim Suchart As String 
07.
Dim xOpt As Integer 
08.
 
09.
Private Sub CheckBox1_Click() 
10.
If CheckBox1.Value = True Then 
11.
    Suchart = xlWhole 
12.
Else 
13.
    Suchart = xlPart 
14.
End If 
15.
End Sub 
16.
 
17.
Private Sub CheckBox2_Click() 
18.
If CheckBox2.Value = True Then 
19.
    ComboBox1.Enabled = False 
20.
Else 
21.
    ComboBox1.Enabled = True 
22.
End If 
23.
End Sub 
24.
 
25.
Private Sub CommandButton1_Click() 
26.
Dim xSuche, xAdresse, xErste As String 
27.
Dim y As Boolean 
28.
Dim arr() As Variant 
29.
Dim rng As Range 
30.
Dim iCounter, iRowU As Integer 
31.
 
32.
ListBox1.Clear 
33.
xSuche = TextBox1.Value 
34.
If xSuche = "" Then 
35.
    MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!" 
36.
    Exit Sub 
37.
End If 
38.
If ComboBox1.Value = "" And CheckBox2.Value = False Then 
39.
    MsgBox "Bitte geben Sie ein, wo der Begriff gesucht werden soll!", vbExclamation, "Achtung!" 
40.
    Exit Sub 
41.
End If 
42.
For iCounter = 1 To ThisWorkbook.Sheets.Count 
43.
    If CheckBox2.Value = True Or Worksheets(iCounter).Name = ComboBox1.Value Then 
44.
        Set rng = Worksheets(iCounter).Cells.Find _ 
45.
            (xSuche, lookat:=Suchart, LookIn:=xlValues) 
46.
        If Not rng Is Nothing Then 
47.
            With Worksheets(iCounter) 
48.
                xErste = rng.Address(False, False) 
49.
                y = True 
50.
                Do Until xAdresse = xErste 
51.
                    ReDim Preserve arr(0 To 6, 0 To iRowU) 
52.
                    arr(0, iRowU) = .Name 
53.
                    arr(1, iRowU) = rng.Address(False, False) 
54.
                    arr(2, iRowU) = .Cells(rng.Row, 1) 
55.
                    arr(3, iRowU) = .Cells(rng.Row, 2) 
56.
                    arr(4, iRowU) = .Cells(rng.Row, 3) 
57.
                    arr(5, iRowU) = .Cells(rng.Row, 4) 
58.
                    arr(6, iRowU) = .Cells(rng.Row, 5) 
59.
                    iRowU = iRowU + 1 
60.
                    Set rng = .Cells.FindNext(after:=rng) 
61.
                    xAdresse = rng.Address(False, False) 
62.
                Loop 
63.
                xAdresse = "" 
64.
                xErste = "" 
65.
            End With 
66.
        End If 
67.
    End If 
68.
Next iCounter 
69.
If y = False Then 
70.
    MsgBox "Der Suchbegriff wurde nicht gefunden!" 
71.
Else 
72.
    ListBox1.Column = arr 
73.
End If 
74.
End Sub 
75.
 
76.
Private Sub CommandButton2_Click() 
77.
Unload Me 
78.
End Sub 
79.
 
80.
Private Sub CommandButton3_Click() 
81.
Dim iCounter, xCounter As Long 
82.
Set wkb1 = ThisWorkbook 
83.
Set wkb2 = Workbooks.Add(1) 
84.
Set wks2 = wkb2.Sheets(1) 
85.
wkb1.Activate 
86.
For iCounter = 0 To ListBox1.ListCount - 1 
87.
    If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then 
88.
        Set XBlatt = Sheets(ListBox1.List(iCounter, 0)) 
89.
        XZeile = Range(ListBox1.List(iCounter, 1)).Row 
90.
        xCounter = xCounter + 1 
91.
        XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter) 
92.
    End If 
93.
Next iCounter 
94.
wks2.Activate 
95.
End Sub 
96.
 
97.
Private Sub CommandButton4_Click() 
98.
Dim iCounter, xCounter As Long 
99.
Set wkb1 = ThisWorkbook 
100.
Set wkb2 = Workbooks.Add(1) 
101.
Set wks2 = wkb2.Sheets(1) 
102.
wkb1.Activate 
103.
For iCounter = ListBox1.ListCount - 1 To 0 Step -1 
104.
    If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then 
105.
        Set XBlatt = Sheets(ListBox1.List(iCounter, 0)) 
106.
        XZeile = Range(ListBox1.List(iCounter, 1)).Row 
107.
        xCounter = xCounter + 1 
108.
        XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter) 
109.
        XBlatt.Rows(XZeile).Delete Shift:=xlUp 
110.
        ListBox1.RemoveItem (iCounter) 
111.
    End If 
112.
Next iCounter 
113.
wks2.Activate 
114.
End Sub 
115.
 
116.
Private Sub CommandButton5_Click() 
117.
Dim iCounter As Long 
118.
If MsgBox("Die markierten Daten werden unwideruflich aus dieser Datei gelöscht." & vbLf & _ 
119.
            "Wollen Sie fortfahren?", vbOKCancel, "Achtung!") = vbOK Then 
120.
    For iCounter = ListBox1.ListCount - 1 To 0 Step -1 
121.
        If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then 
122.
            Set XBlatt = Sheets(ListBox1.List(iCounter, 0)) 
123.
            XZeile = Range(ListBox1.List(iCounter, 1)).Row 
124.
            XBlatt.Rows(XZeile).Delete Shift:=xlUp 
125.
            ListBox1.RemoveItem (iCounter) 
126.
        End If 
127.
    Next iCounter 
128.
End If 
129.
End Sub 
130.
 
131.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 
132.
Application.Goto Sheets(ListBox1.List(ListBox1.ListIndex, 0)).Range(ListBox1.List(ListBox1.ListIndex, 1)) 
133.
End Sub 
134.
 
135.
Private Sub OptionButton1_Click() 
136.
xOpt = 1 
137.
End Sub 
138.
 
139.
Private Sub OptionButton2_Click() 
140.
xOpt = 2 
141.
End Sub 
142.
 
143.
Private Sub UserForm_Initialize() 
144.
For Each wks In Worksheets 
145.
    If wks.Name <> ActiveSheet.Name Then ComboBox1.AddItem wks.Name 
146.
Next 
147.
Suchart = xlPart 
148.
xOpt = 1 
149.
End Sub
Danke Petra

[Edit Biber] Codeformatierung nachgetragen. [/Edit]
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
gelöst VBA Excel Tabellenblätter als PDF speichern (8)

Frage von Florian86 zum Thema Microsoft Office ...

VB for Applications
gelöst Excel VBA Programmierung (7)

Frage von specialuser zum Thema VB for Applications ...

Microsoft Office
gelöst Excel: Wenn Wert in Spalte A dann kopiere Zeile (8)

Frage von michi1983 zum Thema Microsoft Office ...

Neue Wissensbeiträge
Ubuntu

Ubuntu 17.10 steht zum Download bereit

(3)

Information von Frank zum Thema Ubuntu ...

Datenschutz

Autofahrer-Pranger - Bewertungsportal illegal

(8)

Information von BassFishFox zum Thema Datenschutz ...

Windows 10

Neues Win10 Funktionsupdate verbuggt RemoteApp

(8)

Information von thomasreischer zum Thema Windows 10 ...

Microsoft

Die neuen RSAT-Tools für Win10 1709 sind da

(2)

Information von DerWoWusste zum Thema Microsoft ...

Heiß diskutierte Inhalte
Windows 10
Seekrank bei Windows 10 (18)

Frage von zauberer123 zum Thema Windows 10 ...

Windows 10
Windows 10 Fall Creators Update Fehler (13)

Frage von ZeroCool23 zum Thema Windows 10 ...

Router & Routing
gelöst Getrenntes Routing bei VoIP und Daten (12)

Frage von Hobbystern zum Thema Router & Routing ...