Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Frage zum Makro und Optimierung

Forumthread: Frage zum Makro und Optimierung

Frage zum Makro und Optimierung
28.12.2020 14:33:52
Marko
Hallo,
mit diesem Makro wird in ALLEN Sheets die Spalte B hinzugefügt. Das soll jedoch nur in der mit dem Makro hinzugefügten Sheet ausgeführt werden.. Was habe ich falsch gemacht? Und, wie kann das Makro optimiert werden?
Vielen Dank für Eure Hilfe.
Private Sub CommandButton7_Click()
Dim objWB As Workbook
Dim strFile As String
On Error GoTo ErrExit
strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm")
If strFile  "Falsch" Then
Set objWB = Workbooks.Open(strFile)
objWB.Sheets(3).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
objWB.Close False
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = "NEUE DATEI"
End If
ErrExit:
With Err
If .Number  0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (copySheetFromWB) in Modul Modul1", _
vbExclamation, "Fehler in Modul1 / copySheetFromWB"
End With
Set objWB = Nothing
Dim TabName
TabName = InputBox("Bitte geben Sie den Namen ein!", "Blattname")
If TabName = False Then
MsgBox "Eingabe wurde abgebrochen!", vkokOnly, " Blattname"
ElseIf TabName = "" Then
MsgBox "Keine Eingabe vorgenommen!", vkokOnly, " Blattname"
Else
ActiveSheet.Name = TabName
End If
ActiveSheet.Rows("1:6").Delete Shift:=xlUp
ActiveSheet.Rows("1:2").ClearContents
ActiveSheet.Columns("B:C").Insert
ActiveSheet.Range("A1").Value = ActiveSheet.Name
ActiveSheet.Range("C5:C300").FormulaLocal = "=LEFT(A5;5)*1"
MsgBox "Import abgeschlossen", vkokOnly, " Daten Import"
End Sub

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Frage zum Makro und Optimierung
28.12.2020 14:57:49
Nepumuk
Hallo Marko,
so besser?
Option Explicit

Private Sub CommandButton7_Click()
    
    Dim objWB As Workbook
    Dim vntFile As Variant
    Dim strSheetname As String
    
    On Error GoTo ErrExit
    
    vntFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
        "*.xls; *.xlsx; *.xlsm")
    
    If vntFile <> False Then
        
        Set objWB = Workbooks.Open(vntFile)
        
        objWB.Sheets(3).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        
        objWB.Close SaveChanges:=False
        
        Set objWB = Nothing
        
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = "NEUE DATEI"
        
        strSheetname = InputBox("Bitte geben Sie den Namen ein!", "Blattname")
        
        If StrPtr(strSheetname) = 0 Then
            
            MsgBox "Eingabe wurde abgebrochen!", vbExclamation, "Blattname"
            
        ElseIf strSheetname = vbNullString Then
            
            MsgBox "Keine Eingabe vorgenommen!", vbExclamation, "Blattname"
            
        Else
            
            With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                
                .Name = strSheetname
                
                .Rows("1:6").Delete Shift:=xlUp
                
                .Rows("1:2").ClearContents
                
                .Columns("B:C").Insert
                
                .Range("A1").Value = .Name
                
                .Range("C5:C300").FormulaLocal = "=LEFT(A5;5)*1"
                
            End With
            
            MsgBox "Import abgeschlossen", vbInformation, "Daten Import"
            
        End If
    End If
    
    Exit Sub
    
    ErrExit:
    MsgBox "Fehler " & Err.Number & vbLf & vbLf & _
        Err.Description & vbLf & vbLf & "In Prozedur (copySheetFromWB) in Modul Modul1", _
        vbCritical, "Fehler in Modul1 / copySheetFromWB"
End Sub

Gruß
Nepumuk
Anzeige
Frage zum Makro und Optimierung
28.12.2020 15:14:03
Marko
Ja, so funktioniert es. Vielen Dank Nepumuk
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige