Hallo Holger, danke für die Antwort.
Mein Makro bleibt an dieser Stelle stehen:
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
'Solange Spalte Q kleiner gleich 31 ist
Do While Zelle2 <= 31
'verändert die Tabelle je nach Messwerttabelle
'ActiveSheet.Cells(16, Zelle2).Select
'Tabellenblatt Grenzformblatt aktivieren und Zelle Q 6-31 auswählen
Sheets("Grenzmaßformblatt").Activate
Sheets("Grenzmaßformblatt").Cells(17, Zelle2).Select
'Sheets("Grenzmaßformblatt").Cells(Zelle, Spalte).Select
'Kopieren und in B2 einfügen
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<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Genau diese
2 Zeilen werden gelb hinterlegt.
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
Gruß Karin
|