Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1400to1404
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopieren: Makro Optimieren

Kopieren: Makro Optimieren
16.01.2015 09:44:42
Dieter(Drummer)
Guten Tag, VBA Spezialiste,
folgendes Makro habe ich aufgezeichnet und es kann sicher optimiert werden. Select ist ja wohl nicht mehr notwendig und ich weiß nicht, wie ich es ändern kann.
Mit der Bitte um Hilfe und Optimierung.
Gruß, Dieter(Drummer
  • 
    Sub SaldoInJan()
    Range("C13").Select
    Selection.Copy
    Range("C47").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("E13").Select
    Selection.Copy
    Range("E47").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("G13").Select
    Selection.Copy
    Range("G47").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("I13").Select
    Selection.Copy
    Range("I47").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("K13").Select
    Selection.Copy
    Range("K47").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("M13").Select
    Selection.Copy
    Range("M47").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    MsgBox "Saldo ist eingetragen", vbInformation, "Mx: Info"
    End Sub
    


  • 21
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Kopieren: Makro Optimieren
    16.01.2015 09:51:07
    hary
    Moin Dieter
    Reicht evtl.die Value uebergabe?
    with Active.Sheet
    Range("C47").Value =Range("C13").Value
    '--usw.--
    end with
    

    gruss hary

    AW: Korrektur
    16.01.2015 09:53:14
    hary
    Moin nochmal
    ActiveSheet braucht es nicht.
    
    Range("C47").Value =Range("C13").Value
    '--usw.--
    

    gruss hary

    AW: Kopieren: Makro Optimieren
    16.01.2015 09:56:59
    yummi
    Hallo Dieter,
    nur mal so auf die schnelle die selects entfernt (so was gibt es aber auch zum nachlesen im Netz)
    
    Sub SaldoInJan()
    Range("C13").Copy Range("C47")
    Range("E13").Copy Range("E47")
    Range("G13").Copy Range("G47")
    Range("I13").Copy Range("I47")
    Range("K13").Copy Range("K47")
    Range("M13").Copy Range("M47")
    Application.CutCopyMode = False
    MsgBox "Saldo ist eingetragen", vbInformation, "Mx: Info"
    End Sub
    
    Gruß
    yummi

    Anzeige
    oder mit schleife..
    16.01.2015 09:58:06
    ransi
    HAllo
    Option Explicit

    Sub machs()
        Dim I As Integer
        With Sheets("Tabelle1")
            For I = 3 To 13 Step 2
                .Cells(13, I).Copy .Cells(47, I)
            Next
        End With
    End Sub


    ransi

    Anzeige
    AW: Dank an Alle. Alles gut Lösungen, aber ...
    16.01.2015 10:19:58
    Dieter(Drummer)
    das Makro von ransi, Schleifen Makro, bleibt bei mir hängen (fette Zeile):
    Sub SaldoInJan()
    Workbooks.Open Filename:="C:\RabVeraMg.xls"
    Dim I As Integer
    With Sheets("RabVeraMg")
    For I = 3 To 13 Step 2
    .Cells(13, I).Copy .Cells(47, I)
    Next
    End With
    End Sub
    
    Bitte um weitere Hilfe.
    Gruß,
    Dieter(Drummer)

    AW: Dank an Alle. Alles gut Lösungen, aber ...
    16.01.2015 10:31:44
    ransi
    HAllo Dieter
    Gibt es in der MAppe in der das Makro steht ein TAbellenblatt "RabVeraMg" ?
    ransi

    AW: Nein ransi, ...
    16.01.2015 12:08:31
    Dieter(Drummer)
    das Makro ist in einer anderen Datei und wird von dort aus aufgerufen. Gibt's da eine Lösung?
    Danke für Hilfe schonmal.
    Gruß,
    Dieter(Drummer)

    Anzeige
    AW: Nein ransi, ...
    16.01.2015 12:15:10
    Rudi
    Hallo,
    dann doch einfach mit
    With Workbooks("DasMitVera.xlsx").Sheets("RabVeraMg")
    Gruß
    Rudi

    AW: Habe meinen Fehler gefunden ...
    16.01.2015 12:25:36
    Dieter(Drummer)
    Hallo Rudi,
    ich hatte statt Sheet, den Namen des Worbooks eingetragen. Hier nun mein Code (angepasst von ransi).
    Leider wird aber nur eine 1 eingetragen, statt der richtigen Zahl, die meherer Sellen haben kann und es soll auch wieder in allen Sheets gemacht werden, "VeraBs01 und VeraV02 bis VeraV30:
  • Sub SaldoInJan()
    Dim I As Integer
    Workbooks.Open Filename:="C:\RabVeraMg.xls"
    With Sheets("VeraBsV01")
    For I = 3 To 13 Step 2
    .Cells(13, I).Copy .Cells(47, I)
    Next
    End With
    End Sub
    

  • Gruß, Dieter(Drummer)

    Anzeige
    AW: Fehler mit der 1 gefunden
    16.01.2015 12:35:03
    Dieter(Drummer)
    Hi Rudi,
    die 1 kam aus Zelle 13 und musste aber aus Zelle 15 kommen, Hab es geändert und es geht.
    Nun fehlt mir nur noch, dass es in der Tabelle VeraBsV01 und den Tabellen VeraV02 bis Vera30 auch noch per Schleife geht.
    Wäre schön wenn das noch geht.
    Gruß, Dieter(Drummer)
    Hier der jetzige Code:
    Sub SaldoInJan()
    Dim I As Integer
    Workbooks.Open Filename:="C:\RabVeraMg.xls"
    With Sheets("VeraBsV01")
    For I = 3 To 13 Step 2
    .Cells(15, I).Copy .Cells(47, I)
    Next
    End With
    End Sub
    

    AW: Fehler mit der 1 gefunden
    16.01.2015 12:46:09
    yummi
    Hallo dieter,
    sollte so gehen:
    
    Sub SaldoInJan()
    Dim I As Integer
    Dim Blatt As Object
    Workbooks.Open Filename:="C:\RabVeraMg.xls"
    On Error Resume Next
    For Each Blatt In Worksheets
    With Blatt
    For I = 3 To 13 Step 2
    .Cells(15, I).Copy .Cells(47, I)
    Next
    End With
    next blatt
    End Sub
    
    Gruß
    yummi

    Anzeige
    AW: Danke yummi ... und an alle Helfer ...
    16.01.2015 13:03:19
    Dieter(Drummer)
    es klappt prima!
    Noch einen schönen Tag und Danke.
    Gruß, Dieter(Drummer)
    PS Schleifenprogrammierung ist super, aber für mich nicht so einfach!

    AW: Geht es auch über mehr als ein Workbook
    16.01.2015 13:17:31
    Dieter(Drummer)
    Hi Yummi,
    kann man das makro noch so ändern, dass es nicht nur über eine Date mit den Sheets geht, sondern direkt insgesamt über 4 Workbooks mit den gleichen SheetsNamen und die Zellen sind in allen geich.
    Wäre toll wenn das geht.
    Gruß, Dieter(Drummer)

    AW: Geht es auch über mehr als ein Workbook
    16.01.2015 13:30:38
    Rudi
    Hallo,
    auch per Schleife.
    Sub SaldoInJan()
    Dim i As Integer, j As Integer, arrWkb
    arrWkb = Array("C:\RabVeraMg.xls", "C:\RabVeraMg_1.xls", "C:\RabVeraMg_2.xls", "C:\ _
    RabVeraMg_3.xls")
    For j = 0 To 3
    Workbooks.Open Filename:=arrWkb(j)
    With Sheets("VeraBsV01")
    For i = 3 To 13 Step 2
    .Cells(15, i).Copy .Cells(47, i)
    Next
    End With
    Workbooks(arrWkb(j)).Close True
    Next j
    End Sub
    

    Gruß
    Rudi

    Anzeige
    AW: Danke Rudi, es klappt prima!
    16.01.2015 13:45:20
    Dieter(Drummer)
    Gruß, Dieter(Drummer)

    AW: Geht noch eine Erweiterung?
    16.01.2015 14:41:18
    Dieter(Drummer)
    Hi Rudi,
    kannst du mir das Makro so erweitern, wenn das Makro durch ist, in den Zellen (C15, E15, G15, I15, K15, M15), der Inhalt (Zahl) gelöscht wird, aber erst, wenn die Zahlen in die Zellen. Dies auch in allen den Dateien und Sheets.
    Wäre schön wenn das noch geht und ich hoffe, ich nerve nicht.
    Gruß, Dieter(Drummer)
    Jetztiger Code:
    Sub SaldoInJan()
    Dim i As Integer, j As Integer, arrWkb
    arrWkb = Array("C:\Rab\RabVeraMg.xls", "C:Rab\RabVeraRy.xls", "C:\Rab\RabVeraVie.xls", "C:\ _
    Rab\RAB-Jahrwechsel\RabVeraWi.xls")
    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationManual
    End With
    For j = 0 To 3
    Workbooks.Open Filename:=arrWkb(j)
    With Sheets("VeraBsV01")
    For i = 3 To 13 Step 2
    .Cells(15, i).Copy .Cells(47, i)
    Next
    End With
    'Workbooks(arrWkb(j)).Close True
    Next j
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationAutomatic
    End With
    End Sub
    

    Anzeige
    AW: Geht noch eine Erweiterung?
    16.01.2015 14:48:26
    yummi
    Hallo Dieter,
    
    Sub SaldoInJan()
    Dim i As Integer, j As Integer, arrWkb
    arrWkb = Array("C:\Rab\RabVeraMg.xls", "C:Rab\RabVeraRy.xls", "C:\Rab\RabVeraVie.xls", "C:\ _
    Rab\RAB-Jahrwechsel\RabVeraWi.xls")
    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationManual
    End With
    For j = 0 To 3
    Workbooks.Open Filename:=arrWkb(j)
    On Error Resume Next
    For Each Blatt In Worksheets
    With Blatt
    For i = 3 To 13 Step 2
    .Cells(15, i).Copy .Cells(47, i)
    .Cells(15,i).value = ""          'löscht den Inhalt der Zelle nach dem kopieren
    Next
    End With
    Next Blatt
    'Workbooks(arrWkb(j)).Close True
    Next j
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationAutomatic
    End With
    End Sub
    
    Damit es auch wieder über alle Sheets geht.
    Gruß
    yummi

    Anzeige
    AW: Abbruch mit Variable Blatt nicht definiert
    16.01.2015 14:55:19
    Dieter(Drummer)
    Hi yummi,
    Danke für Hilfe. Makro bricht aber ab, mit: Variable Blatt nicht definiert.
    Danke für weitere Bemühung.
    Gru, Dieter(Drummer)

    AW: Abbruch mit Variable Blatt nicht definiert
    16.01.2015 14:58:04
    yummi
    Hallo Dieter,
    dass war ja auch schon ddrin in meiner letzten Version, hättest Du nur gucken brauchen
    
    Sub SaldoInJan()
    Dim i As Integer, j As Integer, arrWkb
    dim Blatt as Object 'wenn er hier mault Objekt anstatt Object. Kann nicht mehr überprüfen
    arrWkb = Array("C:\Rab\RabVeraMg.xls", "C:Rab\RabVeraRy.xls", "C:\Rab\RabVeraVie.xls", "C:\ _
    Rab\RAB-Jahrwechsel\RabVeraWi.xls")
    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationManual
    End With
    For j = 0 To 3
    Workbooks.Open Filename:=arrWkb(j)
    On Error Resume Next
    For Each Blatt In Worksheets
    With Blatt
    For i = 3 To 13 Step 2
    .Cells(15, i).Copy .Cells(47, i)
    .Cells(15,i).value = ""          'löscht den Inhalt der Zelle nach dem kopieren
    Next
    End With
    Next Blatt
    'Workbooks(arrWkb(j)).Close True
    Next j
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationAutomatic
    End With
    End Sub
    
    Gruß
    yummi

    Anzeige
    AW: Abbruch mit Variable Blatt nicht definiert
    16.01.2015 15:00:08
    yummi
    Hallo Dieter
    ich hab gerade nochmal letzten Post geschaut ;-)
    einfach am Anfang des Subs wo das andere Dim steht folgendes in die nächste Zeile
    Dim Blatt As Object
    Dann geht es
    Gruß
    yummi

    AW: Danke yummi, es soll aber nur
    16.01.2015 15:29:29
    Dieter(Drummer)
    der Wert in 15 gelöscht werden, nicht Formate oder Hintergründe. Das anschliessende löschen klappt prima.
    Gruß, Dieter(Drummer)

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige