Makro: Spalten kopieren

Question

Hallo Helfer,

ich bekomme wöchentlich Dateien mit immer einem Tabellenblatt: KW1, KW2, KW3 etc,
dort sind in Zeile 2, ab Spalte C, die Spaltenüberschriften: Hb, Fb, Tt, Bb, Mg, etc.
Dieses Tabellenblatt verschiebe ich in eine bestehende Datei.
Dort gibt es die Tabellenblätter: Hb, Fb, TT, BB, Mg, etc.
Dann sollen alle Spalten ab C, aus dem Tab.blatt KW39, entsprechend der Überschrift in Zeile 2 in die gleichnamigen Tabellenblätter kopiert werden. Zu Beginn des Makros soll aber per InputBox einmal der Spaltenbuchstabe (ist für alle gleich) in den Zieltabellen abgefragt werden.

Ich hoffe ich habe mein Anliegen nachvollziehbar formuliert.
Schon mal vielen Dank im Voraus
mfg

Wolfgang

Answer 1

Hallo Wolfgang,

ich hoffe, ich habe Deine Frage richtig verstanden. Mit nachfolgendem Makro wird zunächst ein Eingabefenster geöffnet, in das die Spaltenindexzahl für die Saplte, in der die kopierten Spalten eingefügt werden sollen, eingetragen werden muss. Danach wird im aktiven Blatt (in meinem Beispiel Blattname KW39) die Überschriften mit den Tabellenblattnamen in der Datei verglichen. Wenn eine Übereinstimmung gefunden wurde, wird die Spalte in das gefundene Tabellenblatt in die Spalte aus der Eingabe eingefügt.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Spalten_kopieren()
Dim intColumn As Integer
Dim intSheets As Integer

Dim varColumnEingabe As Variant

varColumnEingabe = InputBox("Bitte geben Sie die Spalte ein, in das die Daten eingefügt werden sollen", "Spaltenabfrage...", 1)

If varColumnEingabe = False Or varColumnEingabe = "" Then Exit Sub

If Not IsNumeric(varColumnEingabe) Then
MsgBox "Eingabe entspricht nicht der Gültigkeit. Bitte starten Sie die Funktion neu." & vbLf & vbLf _
& "Vorgang wird abgebrochen...", vbInformation, "falsche Eingabe..."
Exit Sub
End If

For intColumn = 3 To ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For intSheets = 1 To Sheets.Count
If Sheets(intSheets).Name = ActiveSheet.Cells(1, intColumn) Then
ActiveSheet.Columns(intColumn).Copy _
Sheets(intSheets).Columns(CInt(varColumnEingabe))
End If
Next intSheets
Next intColumn

End Sub

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo Oliver,
dein "Vorwort" beschreibt nochmal kurz das was mein Anliegen ist. Das Makro wird also wohl tun was es soll.
Ich habe jetzt doch noch etwas Zeit und gerade das Makro getestet.
Erst war ich etwas erschreckt, das es nichts tut. Dann habe ich gesehen das Zeile 1, nicht Zeile 2 verglichen wird. das ist geändert, nun ist es super. Meine Maus freut sich mit, (die PC-Maus!), ich muss sie wieder ein bisschen weniger über den Tisch jagen.

Eine Kleinigkeit(?) hätte ich noch:
In einem Makro (von Hajos Excelseite) wird auch die Spalte abgefragt, dort aber ausdrücklich der Buchstabe:
Application.InputBox("Bitte geben Sie die Spalte als Buchstabe ein", _ "Spalte", StSpV, Type:=2)

Lässt sich das relativ einfach ändern, damit das auch hier so funktioniert?

Vielen Dank
mfg
Wolfgang

Answer 3

Hallo Wofgang,

was bringt Dir das für Vorteile?

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 4

Hallo Wolfgang,

ich nochmal. Nachfolgend der geänderte Code.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Spalten_kopieren()
Dim intColumn As Integer
Dim intSheets As Integer

Dim strColumnEingabe As String

strColumnEingabe = InputBox("Bitte geben Sie die Spalte ein, in das die Daten eingefügt werden sollen", "Spaltenabfrage...", "A")

If strColumnEingabe = "" Then Exit Sub

If IsNumeric(strColumnEingabe) Then
MsgBox "Eingabe entspricht nicht der Gültigkeit. Bitte starten Sie die Funktion neu." & vbLf & vbLf _
& "Vorgang wird abgebrochen...", vbInformation, "falsche Eingabe..."
Exit Sub
End If

For intColumn = 3 To ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For intSheets = 1 To Sheets.Count
If Sheets(intSheets).Name = ActiveSheet.Cells(1, intColumn) Then
ActiveSheet.Columns(intColumn).Copy _
Sheets(intSheets).Columns(CInt(Range(strColumnEingabe & 1).Column))
End If
Next intSheets
Next intColumn

End Sub
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 5

Hallo Oliver,
nochmal vielen Dank.
Die Bennenung der Spalten mit Buchstaben ist einfach das, was Excelnutzer gewohnt sind.
Für eine Zifferneingaben hätte ich sonst noch irgend ein Hilfskonstrukt gebraucht, das für Spaltenbuchstaben die richtige Ziffer erzeugt.
=SPALTE(INDIREKT(A1&1)). Dies z.B. steht in Zelle B1, bei Eingabe in Zelle A1 z.B." IV" ist das Ergebnis 256.
mfg
Wolfgang