Vermeiden von "Sheets("Tabelle1").Select"

Bild

Betrifft: Vermeiden von "Sheets("Tabelle1").Select"
von: Alex Strenge
Geschrieben am: 21.04.2015 19:05:43

Hallo,
ich bin seit einigen Tagen dabei VBA zu nutzen. Eigentlich klappt es ziemlich gut.
Nun sitze ich seit mehreren Stunden an einem Problem:
Und zwar muss ich jedesmal den Code "Select Sheet" nutzen da es sonst zum Laufzeitfehler 1004 kommt. Wie kann ich das vermeiden?
Dieser Code funktioniert:

Sub Gamsblatt()
' Gamsdatenblatt_erstellen Makro
'Replace "Sheet1" with the name of the sheet to be copied.
    ActiveWorkbook.Sheets("Gams_Bsp-Bsp").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = "Gams_Neu-Neu"
' Parameter definieren
Dim lspalte2 As Long
    lspalte2 = Worksheets("Daten_Neu-Neu").Cells(8, Columns.Count).End(xlToLeft).Column
    Sheets("Daten_Neu-Neu").Select
    ActiveSheet.Range(Cells(8, 1), Cells(8, lspalte2)).Copy
    ActiveSheet.Paste Destination:=Worksheets("Gams_Neu-Neu").Range("C4")
    Worksheets("Gams_Neu-Neu").Range("B5").PasteSpecial Transpose:=True
    Application.CutCopyMode = False
'Formel einfügen in Zelle C5
    Sheets("Gams_Neu-Neu").Range("C5").FormulaR1C1 = _
        "=IF(COUNTIF('Daten_Neu-Neu'!R[9]C2:R[9]C15,'Gams_Neu-Neu'!R4C),'Gams_Neu-Neu'!R3C,)"
 
'Matrix_Ausfuellen
Dim LastCol1 As Long, LastRow1 As Long
    
     LastCol1 = Sheets("Gams_Neu-Neu").Cells(4, Columns.Count).End(xlToLeft).Column
     LastRow1 = Sheets("Gams_Neu-Neu").Cells(Rows.Count, "B").End(xlUp).Row
    Sheets("Gams_Neu-Neu").Select
    Sheets("Gams_Neu-Neu").Range("C5", Cells(LastRow1, LastCol1)).FormulaR1C1 = Sheets(" _
Gams_Neu-Neu").Range("C5").FormulaR1C1
End Sub

Dieser Code funktioniert nicht (aber so hätte ich ihn eigentlich in der Art):
Sub Gamsblatt()
' Gamsdatenblatt_erstellen Makro
'Replace "Sheet1" with the name of the sheet to be copied.
    ActiveWorkbook.Sheets("Gams_Bsp-Bsp").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = "Gams_Neu-Neu"
' Parameter definieren
Dim lspalte2 As Long
    lspalte2 = Worksheets("Daten_Neu-Neu").Cells(8, Columns.Count).End(xlToLeft).Column
    Sheets("Daten_Neu-Neu").Range(Cells(8, 1), Cells(8, lspalte2)).Copy Destination:=Worksheets( _
"Gams_Neu-Neu").Range("C4")
    Worksheets("Gams_Neu-Neu").Range("B5").PasteSpecial Transpose:=True
    Application.CutCopyMode = False
'Formel einfügen in Zelle C5
    Sheets("Gams_Neu-Neu").Range("C5").FormulaR1C1 = _
        "=IF(COUNTIF('Daten_Neu-Neu'!R[9]C2:R[9]C15,'Gams_Neu-Neu'!R4C),'Gams_Neu-Neu'!R3C,)"
 
'Matrix_Ausfuellen
Dim LastCol1 As Long, LastRow1 As Long
    
     LastCol1 = Sheets("Gams_Neu-Neu").Cells(4, Columns.Count).End(xlToLeft).Column
     LastRow1 = Sheets("Gams_Neu-Neu").Cells(Rows.Count, "B").End(xlUp).Row
    Sheets("Gams_Neu-Neu").Range("C5", Cells(LastRow1, LastCol1)).FormulaR1C1 = Sheets(" _
Gams_Neu-Neu").Range("C5").FormulaR1C1
End Sub

Danke schonmal für die Hilfe. Ich hoffe, dass ich alle Regeln soweit eingehalten habe.

Bild

Betrifft: AW: Vermeiden von "Sheets("Tabelle1").Select"
von: Hajo_Zi
Geschrieben am: 21.04.2015 19:14:07
vielleicht so?

Option Explicit
Sub Gamsblatt()
    ActiveWorkbook.Sheets("Gams_Bsp-Bsp").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = "Gams_Neu-Neu"
    Dim lspalte2 As Long
    lspalte2 = Worksheets("Daten_Neu-Neu").Cells(8, Columns.Count).End(xlToLeft).Column
    With Sheets("Daten_Neu-Neu")
        .Range(.Cells(8, 1), .Cells(8, lspalte2)).Copy Worksheets("Gams_Neu-Neu").Range("C4")
        Worksheets("Gams_Neu-Neu").Range("B5").PasteSpecial Transpose:=True
        .Range("C5").FormulaR1C1 = _
            "=IF(COUNTIF('Daten_Neu-Neu'!R[9]C2:R[9]C15,'Gams_Neu-Neu'!R4C),'Gams_Neu-Neu'!R3C,) _
"
        Dim LastCol1 As Long, LastRow1 As Long
    End With
    LastCol1 = Sheets("Gams_Neu-Neu").Cells(4, Columns.Count).End(xlToLeft).Column
    LastRow1 = Sheets("Gams_Neu-Neu").Cells(Rows.Count, "B").End(xlUp).Row
    Sheets("Gams_Neu-Neu").Range("C5", Cells(LastRow1, LastCol1)).FormulaR1C1 = Sheets("  _
Gams_Neu-Neu").Range("C5").FormulaR1C1
End Sub



Bild

Betrifft: AW: Vermeiden von "Sheets("Tabelle1").Select"
von: Alex Strenge
Geschrieben am: 21.04.2015 19:42:29
Was bringt das "With"? Bindet der sozusagen das Tabellenblatt ein?
Leider entsteht aber trotzdem der Laufzeitfehler 1004

Bild

Betrifft: AW: Vermeiden von "Sheets("Tabelle1").Select"
von: Hajo_Zi
Geschrieben am: 21.04.2015 19:47:38
das ist der Bezug zur Tabelle.
Ich baue keine Datei nach, die Zeit hat schon jemand investiert.
Ein Nachbau sieht bestimmt anders aus als das Original.
Ein Link zur Datei oder ein Tabellen Ausschnitt nicht als Bild wäre nicht schlecht.
Gruß Hajo

Bild

Betrifft: AW: Vermeiden von "Sheets("Tabelle1").Select"
von: Daniel
Geschrieben am: 21.04.2015 19:20:17
Hi
wenn du Range(Cells(), Cells()) verwendest, muss das Worksheet nicht nur vor der Range, sondern auch vor den beiden Cells innerhalb der Range stehen:

Worksheets().Range(Worksheets().Cells(), Worksheets().Cells())
befindet sich der Code in einem allgemeinen Modul, darf sogar das Worksheet VOR der Range entfallen, aber vor den beiden Cells innerhalb der Range muss es stehen:
Range(Worksheets().Cells(), Worksheets().Cells())
da das den Code etwas unnübersichlich macht, sollte man hier den Zellbereich etwas andes beschreiben, bspw anstelle von:
Range(Cells(8, 1), Cells(8, lspalte2))
nimm man:
Cells(8, 1).Resize(1, lspalte2)
dann muss man das worksheet nur einmal schreiben.
Gruß Daniel

Bild

Betrifft: AW: Vermeiden von "Sheets("Tabelle1").Select"
von: Alex Strenge
Geschrieben am: 21.04.2015 19:41:01
Hallo Daniel,
also hier klappt das wunderbar:

Dim lspalte2 As Long
    lspalte2 = Worksheets("Daten_Neu-Neu").Cells(8, Columns.Count).End(xlToLeft).Column
    Sheets("Daten_Neu-Neu").Cells(8, 1).Resize(1, lspalte2).Copy
    ActiveSheet.Paste Destination:=Worksheets("Gams_Neu-Neu").Range("C4")
    Worksheets("Gams_Neu-Neu").Range("B5").PasteSpecial Transpose:=True
    Application.CutCopyMode = False
Wie bekomme ich nun das "ActiveSheet.Paste" noch weg?
Und weiter unten fügt er mir leider zu viele Spalten und Zeilen ein bei folgendem Code:
Dim LastCol1 As Long, LastRow1 As Long
    
     LastCol1 = Sheets("Gams_Neu-Neu").Cells(4, Columns.Count).End(xlToLeft).Column
     LastRow1 = Sheets("Gams_Neu-Neu").Cells(Rows.Count, "B").End(xlUp).Row
     Sheets("Gams_Neu-Neu").Cells(5, 3).Resize(LastRow1, LastCol1).FormulaR1C1 = Sheets("Gams_Neu-Neu").Range("C5").FormulaR1C1


Bild

Betrifft: AW: Vermeiden von "Sheets("Tabelle1").Select"
von: Daniel
Geschrieben am: 21.04.2015 19:47:29
Hi
die Alternive zu ActiveSheet.Paste hast du doch schon selber in deinem Code verwendet:

ZielZelle.PasteSpecial xlPasteAll

(bei Zielzelle gibt man die linke obere Zelle des Zielbereichs an)
bei Resize musst du immer die Anzahl der Zeilen oder Spalten angeben.
wenn jetzt Start- und Endzeile/-spalte bekannt sind und der Startwert nicht 1 ist, musst du die Anzahl berechnen:
EndWert - StartWert + 1
Gruß Daniel

Bild

Betrifft: AW: Vermeiden von "Sheets("Tabelle1").Select"
von: Alex Strenge
Geschrieben am: 21.04.2015 20:00:09
Danke! Hat geklappt.

Sub Gamsblatt()
' Gamsdatenblatt_erstellen Makro
'Replace "Sheet1" with the name of the sheet to be copied.
    ActiveWorkbook.Sheets("Gams_Bsp-Bsp").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = "Gams_Neu-Neu"
' Parameter definieren
Dim lspalte2 As Long
    lspalte2 = Worksheets("Daten_Neu-Neu").Cells(8, Columns.Count).End(xlToLeft).Column
    Sheets("Daten_Neu-Neu").Cells(8, 1).Resize(1, lspalte2).Copy
    Worksheets("Gams_Neu-Neu").Range("C4").PasteSpecial xlPasteAll
    Worksheets("Gams_Neu-Neu").Range("B5").PasteSpecial Transpose:=True
    Application.CutCopyMode = False
'Formel einfügen in Zelle C5
    Sheets("Gams_Neu-Neu").Range("C5").FormulaR1C1 = _
        "=IF(COUNTIF('Daten_Neu-Neu'!R[9]C2:R[9]C15,'Gams_Neu-Neu'!R4C),'Gams_Neu-Neu'!R3C,)"
 
'Matrix_Ausfuellen
Dim LastCol1 As Long, LastRow1 As Long
    
     LastCol1 = Sheets("Gams_Neu-Neu").Cells(4, Columns.Count).End(xlToLeft).Column
     LastRow1 = Sheets("Gams_Neu-Neu").Cells(Rows.Count, "B").End(xlUp).Row
     Sheets("Gams_Neu-Neu").Cells(5, 3).Resize(LastRow1 - 4, LastCol1 - 2).FormulaR1C1 = Sheets( _
"Gams_Neu-Neu").Range("C5").FormulaR1C1
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Farbteppich über nicht ausgeblendeten Bereich"