Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Automatisches Übernehmen von Überschriften

Automatisches Übernehmen von Überschriften
02.01.2006 11:26:39
Überschriften
Hallo Freaks,
wie stelle ich es an, dass die Überschriften und verschiedene Zellen davor/dahinter von Tabelle 2 nach Tabelle 1 übertragen werden, ohne dass man die Schaltfläche betätigen und Zeile für Zeile markieren muss? Als Auswahlkriterium sollen die Zahlen in Spalte A der Tabelle 2 dienen, d.h., dass nur die Werte aus dieser Zeile kopiert werden sollen. Alles klar?
Zum besseren Verständnis habe ich meine Arbeitsmappe hochgeladen. - Wie muss der Code geändert werden?
https://www.herber.de/bbs/user/29619.xls
Für Eure Hilfe wie immer dankbar
Konni :-)

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hier noch der Code dazu
02.01.2006 11:57:32
Konni
Option Explicit

Sub MehrFachKopie() 'mit freundlicher Unterstützung von ErichG.
If MsgBox("Wollen Sie wirklich diese Zeile kopieren?", vbYesNo, "Sicherheitsabfrage") = vbNo Then Exit Sub
Dim strQ As Variant, strZ As Variant, ii As Integer
Dim intZeQ As Integer, intZeZ As Integer, rngLast As Range
Dim strZleerVon As String, strZleerBis As String
Dim calcMode As XlCalculation
calcMode = Application.Calculation        ' Beschleunigung
Application.Calculation = xlCalculationManual
'                                               ' Vorgaben:
strQ = Split("B C D E F G")   ' Vorgabe der Quellspalten
strZ = Split("C D E F G H")    ' Vorgabe der Zielspalten
strZleerVon = "B"                                ' - erste  leere Zielspalte
strZleerBis = "D"                                ' - letzte leere Zielspalte
With Workbooks("Test04 Nachtragstabelle.xls").Worksheets("Nachtragsübersicht") ' - Zieltabelle
Set rngLast = Range(.Columns(strZleerVon), .Columns(strZleerBis))
' erste freie Zeile in Zielspalten
intZeZ = .Range(strZleerVon & CStr(Rows.Count)).End(xlUp).Row + 1
While WorksheetFunction.CountBlank(rngLast.Rows(intZeZ)) _
< rngLast.Columns.Count
intZeZ = intZeZ + 1
Wend
intZeQ = ActiveCell.Row                ' Zeilennummer der aktiven Zelle
For ii = LBound(strQ) To UBound(strQ)  ' Kopien erstellen
Range(strQ(ii) & CStr(intZeQ)).Copy _
Destination:=.Range(strZ(ii) & CStr(intZeZ))
Next ii
End With
Application.Calculation = calcMode        ' Beschleunigung Ende
End Sub

Grüsse
Konni
Anzeige
AW: Automatisches Übernehmen von Überschriften
02.01.2006 12:25:21
Überschriften
hi
unter https://www.herber.de/bbs/user/29624.xls
hab ich mal einen makro hingelegt, der alle zeilen
die eine nt-nr 1 enthalten, rüberkopiert.
mfg
AW: Automatisches Übernehmen von Überschriften
02.01.2006 12:49:44
Überschriften
Hallo Eugen,
zuerst mal vielen Dank für Deine Unterstützung.
Leider zerschießt das Makro die Tabelle 1 total. Von der Funktion her ist es dem Grunde nach schon richtig, aber es sollen nur bestimmte Zellen einer Zeile aus Tabelle 2 in die nächste Zeile der Tabelle 1 übertragen werden. Und dort nur bis einschl. Spalte H. Siehe meine Vorlage.
Gruß
Konni
AW: Automatisches Übernehmen von Überschriften
02.01.2006 14:29:11
Überschriften
hi
was zerschiesst der makro in blatt 1 ?
ich hab dir den quälcode nochmal mit zwei bemerkungen angehängt.
Public

Sub copy_2_1()
Application.ScreenUpdating = False
--->    ' löscht inhalte zeile 5 bis blattende und von spalte c bis h
Sheets(1).Range(Sheets(1).Cells(5, 3), Sheets(1).Cells(65535, 8)).ClearContents
nRow = 5
calcMode = Application.Calculation
Application.Calculation = xlCalculationManual
For i = 10 To Sheets(2).UsedRange.Rows.Count
If Sheets(2).Cells(i, 1).Value <> "" Then   ' übetragen
--->        ' stimmt hier vielleicht der spaltenversatz von blatt 2 zu blatt 1 nicht ?
Sheets(1).Cells(nRow, 3).Value = Sheets(2).Cells(i, 2).Value
Sheets(1).Cells(nRow, 4).Value = Sheets(2).Cells(i, 3).Value
Sheets(1).Cells(nRow, 5).Value = Sheets(2).Cells(i, 4).Value
Sheets(1).Cells(nRow, 6).Value = Sheets(2).Cells(i, 5).Value
Sheets(1).Cells(nRow, 7).Value = Sheets(2).Cells(i, 6).Value
Sheets(1).Cells(nRow, 8).Value = Sheets(2).Cells(i, 7).Value
Sheets(1).Cells(nRow, 9).Value = Sheets(2).Cells(i, 8).Value
nRow = nRow + 1
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = calcMode
End Sub

mfg
Anzeige
AW: Automatisches Übernehmen von Überschriften
Überschriften
Hallo Eugen,
bei Deiner 1. Fassung wurde die Spalte "Einheitspreise verhandelt" geschreddert. Diese Spalte enthält Formeln, die ich brauche.
Es ist mir durch Probieren gelungen, diesen kleinen Mangel auszumerzen. Danke Dir für Deine Arbeit. Jetzt funktioniert alles Bestens.
Zu Schluss noch eine Frage: Wo/Wie ist bei Dir definiert, ich welche Zeile das Kopieren in Tabelle 1 erfolgen soll? Kannst Du mir diesen letzten Wunsch noch erfüllen?
Vielen herzlichen Dank
und Grüße
Konni :-))
AW: Hat sich erledigt . Danke nochmal und Tschüss
02.01.2006 15:43:35
Konni
...

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige