Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1640to1644
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

Spalten kopieren und einfügen

Spalten kopieren und einfügen
31.08.2018 14:59:46
Tim
Hallo zusammen,
ich habe vor kurzem, von einem netten Forumsmitglied ein Makro bekommen, welches mir Spalten kopiert und in eine neue Tabelle einfügt. Diese Makro funktioniert perfekt, bezieht sich jedoch auf Tabellenblätter deren Inhalt eine "Tabelle" ist. Jetzt habe ich ein Tabellenblatt deren Inhalt keine Tabelle ist, jedoch dasselbe ausgeführt werden soll. Was muss im Code angepasst werden, dass mir das Makro auch Inhalte aus Tabellenblättern kopiert, die nicht so formatiert sind?
Option Explicit
Sub b()
Dim WbQ As Workbook, WbZ As Workbook, WsQ As Worksheet
Dim WsZ As Worksheet, tQ As ListObject, Pfad$
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Bitte einzulesende Datei wählen..."
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen!", vbInformation
Exit Sub
Else: Pfad = .SelectedItems(1)
End If
End With
Application.ScreenUpdating = False
Set WbQ = Workbooks.Open(Pfad)
Set WsQ = WbQ.Worksheets(1): Set tQ = WsQ.ListObjects(1)
Set WbZ = Workbooks.Add(template:=xlWBATWorksheet)
Set WsZ = WbZ.Worksheets(1)
With tQ.DataBodyRange
.Offset(, 1).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 2).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(, 2).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 3).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(, 4).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 12).PasteSpecial (xlPasteValuesAndNumberFormats)
End With
With WsZ
.Activate
.Cells(1, 1) = "Test1"
.Cells(1, 2) = "Test2"
End With
WbQ.Close False
ThisWorkbook.Close False
Set WbQ = Nothing: Set WbZ = Nothing: Set WsQ = Nothing
Set WsZ = Nothing: Set tQ = Nothing
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalten kopieren und einfügen
31.08.2018 17:03:54
onur
"...bezieht sich jedoch auf Tabellenblätter deren Inhalt eine "Tabelle" ist. Jetzt habe ich ein Tabellenblatt deren Inhalt keine Tabelle ist.."?
AW: Spalten kopieren und einfügen
31.08.2018 17:08:07
Hans
Hallo Tim,
wenn ich den Code richtig verstehe ist hier ein Listenfeld Object im Blatt? Der Code ist mir neu!
Ich würde aber hier weiter anknüpfen, sofern es sich um die Tabelle1 handelt:
WsQ.Range("A1:xxx").Copy
WsZ.Cells(1, xxx).PasteSpecial (xlPasteValuesAndNumberFormats)
Wenn du eine andere Tabelle kopieren willst vorher diesen Teil aendern: Set WsQ = WbQ.Worksheets(xx)
Wo du den neuen Code einbaust must du selbst sehen. Am einfachsten hinter der zweiten With Anweisung.
mfg Hans
Anzeige
AW: Spalten kopieren und einfügen
31.08.2018 17:50:45
Tim
Listenfeld Object genau dort denke ich ist das Problem. Man kann in Excel via strg+T oder "Einfügen"= "Tabelle" eine Tabelle im Tabellenblatt erstellen. Ist das Tabellenblatt mit dieser Tabelle (ich nenne es mal Format), dann läuft das Makro wie gewünscht. Ist es ohne das Format, dann kommt ein Fehler. Ziel ist es, das Makro ohne dieses "Tabellen-Format" oder Listenfeld object laufen zu lassen.
darauf zielte meine Anfrage ab, wie gesagt meine VBA Kenntnisse reichen nicht weiter um das anzupassen.
AW: Spalten kopieren und einfügen
31.08.2018 20:44:12
Gerd
Hallo Tim,
du kannst den "normalen Range" natürlich anderst definieren.
Sub bb()
Dim WbQ As Workbook, WbZ As Workbook, WsQ As Worksheet
Dim WsZ As Worksheet, tQ As ListObject, Pfad$
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Bitte einzulesende Datei wählen..."
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen!", vbInformation
Exit Sub
Else: Pfad = .SelectedItems(1)
End If
End With
Application.ScreenUpdating = False
Set WbQ = Workbooks.Open(Pfad)
Set WsQ = WbQ.Worksheets(1)
If WsQ.ListObjects.Count > 0 Then Set tQ = WsQ.ListObjects(1)
Set WbZ = Workbooks.Add(template:=xlWBATWorksheet)
Set WsZ = WbZ.Worksheets(1)
If Not tQ Is Nothing Then
With tQ.DataBodyRange
.Offset(, 1).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 2).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(, 2).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 3).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(, 4).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 12).PasteSpecial (xlPasteValuesAndNumberFormats)
End With
Else
With WsQ.Range("A1").CurrentRegion.Columns(1)
.Offset(, 1).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 2).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(, 2).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 3).PasteSpecial (xlPasteValuesAndNumberFormats)
.Offset(, 4).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 12).PasteSpecial (xlPasteValuesAndNumberFormats)
End With
End If
With WsZ
.Activate
.Cells(1, 1) = "Test1"
.Cells(1, 2) = "Test2"
End With
WbQ.Close False
ThisWorkbook.Close False
Set WbQ = Nothing: Set WbZ = Nothing: Set WsQ = Nothing
Set WsZ = Nothing: Set tQ = Nothing
End Sub

Gruß Gerd
Anzeige
AW: Spalten kopieren und einfügen
01.09.2018 16:52:36
Tim
Perfekt, funktioniert so wie ich es mir vorgestellt habe.
Gibt es noch die Möglichkeit, eine der kopierten Spalten durch einen anderen Wert zu ersetzen? Oder besser gesagt, ich will in Spalte 3 in der neuen Tabelle, auf allen Zeilen die in Spalte 2 eingefügt wurden einen weiteren Wert hinzufügen = Bsp. Spalte 2 die kopiert wurde haben 25 Zeileneinträge und in Spalte 3 sollen in genau diesen Zeilen ein "erledigt" stehen!?
AW: Spalten kopieren und einfügen
02.09.2018 11:17:02
Gerd
Moin Tim,
bitte die letzte Codezeile einfügen.
Else
With WsQ.Range("A1").CurrentRegion.Columns(1)
.Offset(, 1).Resize(.Rows.Count, 1).Copy
WsZ.Cells(1, 2).PasteSpecial (xlPasteValuesAndNumberFormats)
WsZ.Cells(2, 2).Resize(WsZ.Cells(WsZ.Rows.Count, 2).End(xlUp).Row - 1, 1) = "erledigt"

Gruß Gerd
Anzeige
AW: Spalten kopieren und einfügen
02.09.2018 11:29:36
Tim
Vielen Dank, Sie haben mir sehr geholfen!

342 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige