Hallo mal wieder werte forenmitglieder :)
ich habe ein makro geschrieben das mehrere tabellen mit gleichem format aber verschiedenen werten in ein neues tabellenblatt kopiert. Nur leider kommt bei der Paste Spezial Methode der Laufzeitfeler 1004.
"Die Informationen können nicht eingefügt werden, da der Bereich
Kopieren und der Bereich zum Einfügen unterschiedliche Formen und Größen haben."
Hier mein Code:
Option Explicit
Sub Schleife_Kopieren()
'Variablen deklaration
Dim Zelle As Integer, Spalte As Integer
Dim Zelle2 As Integer
Dim Zelle3 As Integer, Spalte3 As Integer
Dim wksBlattNeu As Worksheet
Set wksBlattNeu = Worksheets.Add(Before:=Sheets(3))
wksBlattNeu.Name = Sheets("Grenzmaßformblatt").Range("B1").Value
Application.ScreenUpdating = False
Zelle = 1
Spalte = 1
Zelle2 = 6
Spalte3 = 1
Zelle3 = 1
Do While Zelle2 <= 31
'verändert die Tabelle je nach Messwerttabelle
'ActiveSheet.Cells(16, Zelle2).Select
Sheets("Grenzmaßformblatt").Activate
Sheets("Grenzmaßformblatt").Cells(17, Zelle2).Select
'Sheets("Grenzmaßformblatt").Cells(Zelle, Spalte).Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'
'Kopiert die Spalten der Tabelle in ein Neues Tabellenblatt
Columns("B:O").Select 'wählt die zu kopierenden Spalten aus
Application.CutCopyMode = False
Selection.Copy
Sheets(wksBlattNeu.Name).Select
Sheets(wksBlattNeu.Name).Cells(Zelle3, Spalte3).Select 'Blatt in das eingefügt werden soll
'Sheets("Grenzmaßformblatt").Select
' Range("A1").Select
'einfügen
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'
'Kopiert die Zeilen der Tabelle in ein Neues Tabellenblatt
Rows("1:38").Select 'wählt die zu kopierenden Zeilen aus
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(wksBlattNeu.Name).Cells(Zelle3, Spalte3).Select 'Blatt in das eingefügt werden soll
'einfügen
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'
Sheets("Grenzmaßformblatt").Activate
Sheets("Grenzmaßformblatt").Cells(Zelle, Spalte).Select
'Selection.Copy
'Worksheets("Tabelle2").Cells(Zelle, Spalte + 1).Insert
'End If
'Zelle = Zelle + 1
Zelle3 = Zelle3 + 39
Zelle2 = Zelle2 + 1
Loop
Application.ScreenUpdating = True
End Sub
Also vll. findet ja jemand meinen Fehler. Wäre wirklich toll :)
Gruß
Karin |