Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1104to1108
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
Inhaltsverzeichnis

Makro zum kopieren von Bereichen in neue Tabelle

Makro zum kopieren von Bereichen in neue Tabelle
Bereichen
Hallo zusammen,
https://www.herber.de/bbs/user/64724.xls
ich habe eine große Tabelle die in Spalte A bis E immer die Kategorien darstellt für die dahinterliegenden Blöcke, es gibt mehrere Blöcke insg. 27. Ein Block setzt sich aus mehreren genau definierten Spalten zusammen (s. Excel-tabelle zu kopieren=X, rot sind die ausgeblendeten bzw. eingeklappten Spalten, die nicht kopiert werden sollen).
Ein Block habe ich mal exemplarisch dargestellt in der Excel-Tabelle.
Die Darstellung zeigt wie gesagt nur ein Block, es gibt insgesamt 27 solcher Blöcke. Die anderen Blöcke könnte ich ja - je nach Erfordernis - selbst im Makro anpassen. Wichtig wäre nur, dass das Format/Formatierung mitübernommen wird beim Kopieren.
Übrigens: Pro Block ist die Anzahl der zu kopierenden Spalten immer gleich! (= 10 bestimmte Spalten = 1 Block)
Hat da einer eine Idee wie ich das anstellen könnte?
LG
Jessi

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro zum kopieren von Bereichen in neue Tabelle
27.09.2009 07:25:50
Bereichen
Hallo Jessi,
da sind sie ja wieder deine berühmten 27 Spalten ;-)
Hier ein Makro zum Kopieren von Zellenblöcken abhängig von Prüf-Kriterien.
Gruß
Franz
Sub BloeckeKopieren()
Dim wksQuelle As Worksheet, SpalteQuelle As Long
Dim wksZiel As Worksheet, SpalteZiel As Long
Dim Zeilen_Block As Long, Zeile_1_Block As Long, SpaltenDaten As Long
Dim Spalte_1_Kategorie As Long, SpaltenKategorie As Long
Dim Zeile_1_Ziel As Long, Spalte_1_Ziel As Long
'Zeilen und Spalten-Daten für Blöcke und Ziel
Zeilen_Block = 44       'Anzahl der Zeilen der zu kopierenden Blöcke
Zeile_1_Block = 1       'Zeilennummer der 1. Zeile der Blöcke
SpaltenKategorie = 5    'Anzahl derKategorie-Spalten
SpaltenDaten = 27       'Anzahl der Spalten mit Daten
Spalte_1_Kategorie = 1  'Spalten-Nummer der 1. Kategorie-Spalte, A=1, B=2, ...
Zeile_1_Ziel = 1  'Zeilennummer der 1. Zeile der Blöcke im Zielblatt
Spalte_1_Ziel = 1 'Spalten-Nummer der 1. Kategorie-Spalte im Zielblatt
Set wksQuelle = ActiveWorkbook.Worksheets("Tabelle1")
Set wksZiel = ActiveWorkbook.Worksheets("Tabelle2")
'Altdaten in Zieltabelle löschen
With wksZiel
.Range(.Cells(Zeile_1_Ziel, Spalte_1_Ziel), _
.Cells(Zeile_1_Ziel + Zeilen_Block - 1, _
Spalte_1_Ziel + SpaltenDaten - 1)).Clear
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With wksQuelle
'die 5 Kategorie-Spalten kopieren
SpalteZiel = Spalte_1_Ziel
.Range(.Cells(Zeile_1_Block, Spalte_1_Kategorie), _
.Cells(Zeile_1_Block + Zeilen_Block - 1, _
Spalte_1_Kategorie + SpaltenKategorie - 1)).Copy
wksZiel.Cells(Zeile_1_Ziel, SpalteZiel).PasteSpecial Paste:=xlPasteFormats
wksZiel.Cells(Zeile_1_Ziel, SpalteZiel).PasteSpecial Paste:=xlPasteValues
'Nicht ausgeblendete Datenspalten kopieren
SpalteZiel = Spalte_1_Ziel + SpaltenKategorie - 1
For SpalteQuelle = SpaltenKategorie + 1 To SpaltenKategorie + SpaltenDaten
'Das Prüfkriterieum für das Kopieren der Daten-Spalten ggf. anpassen
'hier: nur die sichtbaren Spalten kopieren
If .Cells(Zeile_1_Block, SpalteQuelle).EntireColumn.Hidden = False Then
.Range(.Cells(Zeile_1_Block, SpalteQuelle), _
.Cells(Zeile_1_Block + Zeilen_Block - 1, SpalteQuelle)).Copy
SpalteZiel = SpalteZiel + 1
'Formate und Werte kopieren
wksZiel.Cells(Zeile_1_Ziel, SpalteZiel).PasteSpecial Paste:=xlPasteFormats
wksZiel.Cells(Zeile_1_Ziel, SpalteZiel).PasteSpecial Paste:=xlPasteValues
End If
Next
End With
wksZiel.Parent.Activate
wksZiel.Activate
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Anzeige
TOP!!!!!! DANKE FRANZ! o.T.
28.09.2009 14:13:00
Jessi
o.T.

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige