Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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
GELÖST

Zeile kopieren und in neues Tabellenblatt einfügen

Frage Microsoft Microsoft Office

Mitglied: Schnufflchen

Schnufflchen (Level 1) - Jetzt verbinden

19.07.2009, aktualisiert 11:47 Uhr, 19624 Aufrufe, 9 Kommentare

Hallo,
ich habe mal wieder ein Problem.
Ich habe zwei Tabellenblätter (Tab1 und Tab2). In Tab1 steht in Spalte F Werte (ab Zeile 2). Wenn dieser Wert in Spalte 1 auf Tab2 gefunden wird, dann soll die komplette Zeile aus Tab1 unterhalb des gefundenen Wertes in Tab2 eingefügt werden. Das Suchen und finden klappt schon, aber bei dem Einfügen hab ich noch Probleme, weil eben das Tabellenblatt gewechselt wird. Ich hoffe es ist einigermaßen verständlich und mir kann jemand wieder so toll weiterhelfen, wie beim letzten Mal.
Dankeschön schon mal im Voraus
Mitglied: Wolfsburger
19.07.2009 um 14:22 Uhr
Worüber sprechen wir hier? Microsoft Excel? Openoffice? Stift und Papier? Datenbanken in Access, SQL, Oracle? Welche Programmversion?
Bitte warten ..
Mitglied: Schnufflchen
19.07.2009 um 15:12 Uhr
Oh sorry. Excel 2007 und ich will das als Makro machen. Also VBA.
Bitte warten ..
Mitglied: Berrnd
19.07.2009 um 20:42 Uhr
Hi,

hier mal ein kleines VBA Beispiel:

01.
'Also hier gehts weiter nachdem die Auswahl selektiert wurde 
02.
Selection.Copy 
03.
Sheets("Name des Ziel Datenblattes").Select 
04.
Range("A2").Select 
05.
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
06.
        :=False, Transpose:=False
Vielleicht hilfts Dir ja weiter.

Viele Grüße
Bernd
Bitte warten ..
Mitglied: 76109
20.07.2009 um 00:04 Uhr
Hallo Schnufflchen!

Das sollte funktionieren:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Sub Test() 
05.
    Dim Wks1 As Worksheet, Wks2 As Worksheet, Found As Range, c As Range 
06.
     
07.
    Set Wks1 = Sheets("Tabelle1"):  Set Wks2 = Sheets("Tabelle2") 
08.
     
09.
    Application.ScreenUpdating = False 
10.
     
11.
    With Wks1 
12.
        For Each c In .Range("F2:F" & .Cells(.Rows.Count, "F").End(xlUp).Row) 
13.
            If  Not IsEmpty(c) Then 
14.
                Set Found = Wks2.Columns("A").Find(c, LookIn:=xlValues, LookAt:=xlWhole) 
15.
                If Not Found Is Nothing Then 
16.
                    .Rows(c.Row).Copy:  Wks2.Rows(Found.Row + 1).Insert Shift:=xlDown 
17.
                End If 
18.
            End If 
19.
        Next 
20.
    End With 
21.
     
22.
    Application.CutCopyMode = False:  Application.ScreenUpdating = True 
23.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: Schnufflchen
20.07.2009 um 09:47 Uhr
Woohoooo, es geht und genauso, wie ich es mir vorgestellt habe. Grandios! Das erspart mir monatlich einige Stunden Arbeit! Dankeschön!
Eine klitzekleine Frage hab ich aber noch. Ist es möglich, mir noch genau zu erklären, was jede Zeile genau macht, damit ich den AUfbau verstehe und zukünftig ein paar Sachen besser im Alleingang hinbekomme?
Bitte warten ..
Mitglied: 76109
20.07.2009 um 10:20 Uhr
Hallo Schnufflchen!

Na, dann erkläre ich mal
01.
Option Explicit 
02.
'Hiermit wird verlangt, dass alle benutzten Variablen definiert werden. 
03.
 
04.
Option Compare Text 
05.
'Hiermit wird festgelegt, dass bei Vergleichs-Operationen (Like, Find...)  
06.
'NICHT zwischen Groß/Klein-Schreibung unterschieden wird.  
07.
 
08.
Sub Test() 
09.
    Dim Wks1 As Worksheet, Wks2 As Worksheet, Found As Range, c As Range 
10.
     
11.
    Set Wks1 = Sheets("Tabelle1"):  Set Wks2 = Sheets("Tabelle2") 
12.
   'Bei Abläufen in verschiedenen Tabs empfielt es sich, die Tabellenblätter explizit 
13.
   'einer Variablen zuzuordnen und diese darüber anzusprechen.  
14.
     
15.
    Application.ScreenUpdating = False 
16.
   'Deaktiviert die Bildschirmaktualisierung während der Makro-Ausführung. 
17.
   'Das Makro wird schneller ausgeführt und der Bildschirm flackert nicht.  
18.
     
19.
    With Wks1 
20.
       'Alle nachfolgenden Anweisungen, die mit einem Punkt beginnen, sind dem 
21.
      'Tabellenblatt Wks1 zuzuordnen.   
22.
 
23.
        For Each c In .Range("F2:F" & .Cells(.Rows.Count, "F").End(xlUp).Row) 
24.
       'c steht für jede einzelne Zelle im Bereich F2:F & Letzte Zeile mit Inhalt in Spalte F 
25.
 
26.
            If  Not IsEmpty(c) Then  'Keine leere Zellen 
27.
                Set Found = Wks2.Columns("A").Find(c, LookIn:=xlValues, LookAt:=xlWhole) 
28.
               'Found ist Zelle, in der der Wert gefunden wurde (xlWohle vergleicht ganzen Zellinhalt)   
29.
 
30.
                If Not Found Is Nothing Then  'Wenn gefunden dann 
31.
  
32.
                    .Rows(c.Row).Copy:  Wks2.Rows(Found.Row + 1).Insert Shift:=xlDown 
33.
                    'Zeile mit Suchwert kopieren und in einer neuen Zeile gefunden +1 einfügen 
34.
                End If 
35.
            End If 
36.
        Next 
37.
    End With 
38.
     
39.
    Application.CutCopyMode = False:  Application.ScreenUpdating = True 
40.
   'Die Kopiermarkierung aufheben und die Bildschirmaktualisierung wieder aktivieren 
41.
 
42.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: Schnufflchen
20.07.2009 um 14:54 Uhr
Aaah, jetzt ist das auch für mich lesbar
Angenommen ich wollte die Zeile aus Tabellenblatt1 erst ab der Spalte F reinkopieren, dann müsste ich einfach die Zeile 32 zu:

wks2.Range(Cells((Found+1),6).insert shift:=xlDown

umändern? Das sind jetzt nur Spielereien, so lern ich das halt immer am besten =)
Bitte warten ..
Mitglied: 76109
20.07.2009 um 16:01 Uhr
Hallo Schnufflchen!

So einfach geht das nicht

Werte aus Tab1 von Spalte A-F in Tab2 in neue Zeile Spalte F-K in etwa so:
01.
If Not Found Is Nothing Then 
02.
   Wks2.Rows(Found.Row + 1).Insert Shift:=xlDown 'Neue Zeile in Tab2 einfügen 
03.
  .Range(c.Offset(0, -5), c.Offset(0, 0)).Copy Destination:=Wks2.Cells(Found.Row + 1, 6) 
04.
   Oder 
05.
  .Range(c.Offset(0, -5), c).Copy Destination:=Wks2.Cells(Found.Row + 1, 6) 
06.
  'In Tab1 Spalte A-F nach Tab2 in neue Zeile Spalte F-K kopieren  
07.
End If
Oder in Tab2 gleiche Zeile Spalte B-G:
01.
If Not Found Is Nothing Then 
02.
  .Range(c.Offset(0, -5), c.Offset(0, 0)).Copy Destination:=Wks2.Cells(Found.Row , 2) 
03.
   Oder 
04.
  .Range(c.Offset(0, -5), c).Copy Destination:=Wks2.Cells(Found.Row , 2) 
05.
  'In Tab1 Spalte A-F nach Tab2 gleiche Zeile Spalte B-G kopieren  
06.
End If
Gruß Dieter
Bitte warten ..
Mitglied: Jensson
11.08.2014 um 14:26 Uhr
Hallo
Ich weis der Thread ist schon etwas alt, aber ich da trotzdem mal ´ne Frage: (Excel 2010)

ich will, dass Werte aus Spalte B (ab B2 bis letzte beschriebene) in ein 2. Tabellenblatt in Spalte E kopieren. Dafür habe ich dein Skript etwas an die Gegebenheiten angepasst, jedoch passiert beim Starten des Makros genau gar nichts :/ Ich bin Einsteiger in VBA/Programmieren allgemein und finde deswegen auch keinen Fehler. Kannst du mir helfen?


Option Compare Text
Option Explicit

Sub KopierenAdm()
Dim T1 As Worksheet, T2 As Worksheet, Found As Range, c As Range

Set T1 = Sheets("Tabelle1"): Set T2 = Sheets("Tabelle2")

Application.ScreenUpdating = False

With T1
For Each c In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
If Not IsEmpty(c) Then
Set Found = T2.Columns("E").Find(c, LookIn:=xlValues, LookAt:=xlWhole)
If Not Found Is Nothing Then
.Rows(c.Row).Copy: T2.Rows(Found.Row + 1).Insert Shift:=xlDown
End If
End If
Next
End With

Application.CutCopyMode = False: Application.ScreenUpdating = True
End Sub


Vielen Dank im Vorraus
Bitte warten ..
Neuester Wissensbeitrag
CPU, RAM, Mainboards

Angetestet: PC Engines APU 3a2 im Rack-Gehäuse

Erfahrungsbericht von ashnod zum Thema CPU, RAM, Mainboards ...

Heiß diskutierte Inhalte
Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

DSL, VDSL
DSL-Signal bewerten (12)

Frage von SarekHL zum Thema DSL, VDSL ...

Windows Server
Mailserver auf Windows Server 2012 (8)

Frage von StefanT81 zum Thema Windows Server ...

Backup
Clients als Server missbrauchen? (8)

Frage von 1410640014 zum Thema Backup ...