VBA Kopieren Tabellenkalkulation

Question

Hallo Leute,

kann mir jemand hierbei bitte helfen.
Das ist mein Makro, die läuft soweit so gut. Über einen Botton in meiner Exceltabelle bringe ich die Marko zum laufen. Nun möchte ich wenn ich den Botton betätige das mein Marko folgendes tut:

1.entweder alle bestehen Zelleninhalte löscht und dann einfach alle neu hinein kopiert plus dem neuen Tabellenblatt
oder
2. um ein neues Tabellenblatt erweitert.

Momentan führt das Makro folgendes aus, nach dem ich den Bottum betätig habe kopiert er alle bestehenden Tabellenblätter mit dem Namen ABT und zusätzlich das neue Tabellenblatt.
Beispiel: Ich habe 5 Tabellenblätter, alle Tabellenblätter heissen ABT 1; ABT2; ABT3 usw.
Diese sind bereits per Marko im Tabellenblatt Archiv abgespeichert. Nun kommt ein 6 Tabellenbalt dazu Namens ABT 6. Betätige ich jetzt den Bottom dann werden alle 5 Tabellenblätter erneut kopiert und zustätlich das neue 6 Tabellenblatt. Wenn jedes Tabellenblatt jeweils 10 Einträge besitzt, dann sollte im Tabellenblatt Archiv normalerweise 50 Zellen + 10 neue Einträge sein.
Die Realität sieht aber so aus... 110 Zelleneinträge. Also die 50 bereitsvorhandenen +50 erneut die gleichen Einträge +die 10 neuen.

Hier ist die Makro:

Sub DATENBANK1SAFinale()
Dim ws As Worksheet

Application.ScreenUpdating = False

Bereich = "A1:X" & Cells(Rows.Count, 1).End(xlUp).Row
Set Quelltab = ActiveWorkbook.Worksheets("Archiv")
Quelltab.Range(Bereich).ClearContents

For Each ws In ActiveWorkbook.Worksheets


If Left(ws.Name, 3) = "ABT" Then

With Worksheets(ws.Name)
.Range("A1:X" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
End With

With Worksheets("Archiv")
.Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With

End If

Next ws

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

Answer 1

Hallo Mo,

ich weiß es ist einfach, nur leider komme ich nicht zum Ziel.
Im Grunde genommen ist es ja einfach von der Excel datei 1 Tabelle 1 Spalte A1:A10 Kopieren und dann
Excel-Datei 2 Öffnen und in Tabelle 2 B1:B10 hineinkopieren.
Nur selbst das bekomme ich nicht mal mehr hin. Da benötige ich Support.


Gruß Flo

Answer 2

Hallo Florian,

aufgrund meiner Antwort 16 probiere mal folgendes Makro:

Sub openandcopy()
Dim anw
Dim Pfad As String
Dim Ziel As String
Dim Datei As String
Dim i As Long
Dim shExists As Boolean

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad anpassen
Pfad = "C:\Test\"

inputname:
Ziel = InputBox("Name of the file to be opend")

If Ziel = "" Then
anw = MsgBox("Invalid name! Try again?", 20, "Error")
If anw = vbYes Then
GoTo inputname
Else
Exit Sub
End If
End If

'Endung ggf. anpassen
Ziel = Ziel & ".xlsx"
Datei = Pfad & Ziel

If Dir(Datei) = "" Then
anw = MsgBox("The file " & Ziel & ".xls doesn't exist! Try again?", 20, "Error")
If anw = vbYes Then
GoTo inputname
Else
Exit Sub
End If
End If

'Zieldatei öffnen
Workbooks.Open Filename:=Datei

'Prüfen ob Tabelle mit Namen "Artikelnr" im geöffneten Workbook existiert
For i = 1 To Workbooks(Ziel).Worksheets.Count
If Workbooks(Ziel).Worksheets(i).Name = "Artikelnr" Then shExists = True
Next i

'Falls nein, dann Meldung und Abbruch
If shExist = False Then
MsgBox "The Worksheet Artikelnr doesn't exit in the Workbook named " & Ziel & "! Abort!", 16, "Error"
Exit Sub
End If

ThisWorkbook.Sheets("Userguide").Range("I6:I16").Copy 'kopieren
With Workbooks(Ziel)
.Sheets("Artikelnr").Range("M1").PasteSpecial Paste:=xlPasteValues 'Nur Werte einfügen
.Close (True) 'speichern und schließen
End With

Application.CutCopyMode = False 'Kopierauswahl aufheben

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

MsgBox "The data was copied", 64, "Copy finished"

End Sub

Zu deiner Frage kopieren mit Auswahl des / der Arbeitsblätter habe ich dir mal eine Beispieldatei erstellt: KLICK MICH!

Gruß

M.O.

Answer 3

Hallo Mo,

danke dir schon mal für die Makro.
Nur leider hat es nicht ganz geklappt.

Die Datei nennt sich Datenbank wo sich das Tabellenblatt Userguide befindet.
Die anderen Dateien die im Ordner Artikel enhalten sind, nennen sich Artikelnummer 123.xls ; Artikelnummer 555.xls, Artiklenummer 887.xls usw. Aber die Tabellenblätter der der jeweiligen Exceldateien, heißen immer ART beschreibung. Diese möchte ich aufrufen könnnen.

Jetzt habe ich im Userguide in Spalte I6:I16 10 Beschreibungen ermittelt. Diese 10 möchte ich jetzt kopieren und beispielsweise in die Exceldatei Artikelnummer 555.xls im Tabellenblatt ART Beschreibung in Spalte M1:M10 hinen kopieren. Ich drücke wieder den Butto der auf diese Makro verweißt, wenn ich erneut 10 weitere Beschreibungen aus dem Userguide zu kopieren habe (immer aus dem bereichen I6:I16) und dann diese 10 Beschreibungen in M11:M21 hinein kopieren usw.

Nächster Tag. Jetzt habe ich wieder 10 Beschreibungen aus dem Userguide I6:I16 die ich zu kopieren habe, dieses mal möchte ich jetzt in die Exceldatei Artikelnummer 123.xls in das Tabellenblatt ART Beschreibung in Spalte M1:M10 hin kopieren. Jetzt weiß ich aber das die Exceldatei Artikelnummer 123.xls in Spalte M 100 Felder leer sind wo aber die beschreibungen vom Userguide I6:I16 hinein müssen. Dann drücke ich den Buttom und die ersten 10 werden kopiert. (wieder aus I6:I16) und dann die weiteren 10 die dann in M11:M21 hinein kopiert werden. usw. bis qusi 100 oder auch mal 300 oder 257 (das ist immer variabel) erreicht wurden. Ich hoffe es ist so besser beschrieben. So
Langsam ist das Ziel erreicht. ;-) danke dir Mo.

Gruß Flo

Answer 4

Hallo Florian,

in deiner Antwort 17 schreibst du

genau so wollte ich das machen wie du das eben aufgelistet hast.

Und dann kommst du mit deiner Antwort 23, dass die Tabellenblätter doch anders heißen etc.?????

Stelle deine Fragen bzw. antworte doch so, dass auch jemand, der keine Ahnung hat, was du willst, erkennt, was das Makro machen soll.

Hier das geänderte Makro:

Global iZiel As String
Sub openandcopy()
Dim anw
Dim Pfad As String
Dim Datei As String
Dim i As Long
Dim shExists As Boolean
Dim lz As Long
Dim Ziel As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad anpassen
Pfad = "C:\Test\"

inputname:
iZiel = InputBox("Name of the file to be opend", "Input Filename", iZiel)

If iZiel = "" Then
anw = MsgBox("Invalid name! Try again?", 20, "Error")
If anw = vbYes Then
GoTo inputname
Else
Exit Sub
End If
End If

'Endung ggf. anpassen
Ziel = iZiel & ".xlsx"
Datei = Pfad & Ziel

If Dir(Datei) = "" Then
anw = MsgBox("The file " & Ziel & " doesn't exist! Try again?", 20, "Error")
If anw = vbYes Then
GoTo inputname
Else
Exit Sub
End If
End If

'Zieldatei öffnen
Workbooks.Open Filename:=Datei

'Prüfen ob Tabelle mit Namen "Artikelnr" im geöffneten Workbook existiert
For i = 1 To Workbooks(Ziel).Worksheets.Count
If Workbooks(Ziel).Worksheets(i).Name = "ART Beschreibung" Then shExists = True
Next i

'Falls nein, dann Meldung und Abbruch
If shExists = False Then
MsgBox "The Worksheet ART Beschreibung doesn't exit in the Workbook named " & Ziel & "! Abort!", 16, "Error"
Exit Sub
End If

ThisWorkbook.Sheets("Userguide").Range("I6:I16").Copy 'kopieren
With Workbooks(Ziel)
lz = .Worksheets("ART Beschreibung").Cells(Rows.Count, 13).End(xlUp).Row + 1
.Worksheets("ART Beschreibung").Range("M" & lz).PasteSpecial Paste:=xlPasteValues 'Nur Werte einfügen
.Close (True) 'speichern und schließen
End With

Application.CutCopyMode = False 'Kopierauswahl aufheben

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

MsgBox "The data was copied", 64, "Copy finished"

End Sub

Gruß
M.O.

Answer 5

Hallo Mo,

vielen Dank für die änderung.
Ja ich versuche es besser zu beschreiben. Ich habe deine geänderete Makro verwendet nur leider klappt es noch nicht.

Das einzige was funktioniert ist das Aufrufen der Inputbox. Und nach dem ich den namen der Exceldatei eintippe,
kommt es schon zum Abbruch.

Hier ist mein Pfad.
Pfad="C:\Users\Documents\Folder\Datei\" & Artikelnummer & ".xls"

Namen der Exceldateien:
Artikelnummer 123.xls
Artikelnummer 555.xls
Artikelnummer 887.xls
Artikelnummer 456.xls usw.

Der Name der Tabellenblätter in den einzelnen Exceldatein, sind immer die selben:
ART Beschreibung

Woran kann es denn nur liegen?

Gruß Flo

Answer 6

Hallo,

ich habe im Makro die Endung mit .xlsx gearbeitet.

Ändere die Zeile

Ziel = iZiel & ".xlsx"

in

Ziel = iZiel & ".xls"

dann sollte es gehen.

Gruß

M.O.

Answer 7

Hallo Mo,

das habe ich natürlich als erstes schon geändert gehabt und angpasst.
Und es hat leider ebenfalls nicht geklappt.

Gruß Flo

Answer 8

Hallo Florian,

wie soll ich das verstehen:

Hier ist mein Pfad.
Pfad="C:\Users\Documents\Folder\Datei\" & Artikelnummer & ".xls"

Wo hast du das in mein Makro eingebaut? Wenn du mein Makro änderst, dann solltest du es auch posten, wenn du dazu eine Frage stellst.

Gruß

M.O.

Answer 9

Hallo Mo,

dort wor du in deiner Makro das hier stehen hast,

'Pfad anpassen
Pfad = "C:\Test\"

habe ich an dieser Stelle dann das hier hingeschrieben.

Pfad="C:\Users\Documents\Folder\Datei\" & Artikelnummer & ".xls"

Gruß Flo

Answer 10

Hallo Florian,

wo kommt die Artikelnummer her??
Wenn du den Pfad anpasst, dann nur so:

Pfad="C:\Users\Documents\Folder\Datei\"

Der vollständige Pfad mit Dateinamen und Dateierweiterung wird erst später generiert.

Wenn du den Pfad so wie du anpasst, kann er die Datei ja nicht finden, da
1. die Artikelnummer leer ist
2. vor dem Namen, den du in die Inputbox eingibst ".xls" gestellt wird.
Damit generiest du einen Namen wie z.B. ".xlsArtikelnummer 123.xls" und diese Datei gibt es natürlich nicht.

Gruß

M.O.