Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1800to1804
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

VBA Auswahl von bestimmten Sheets

VBA Auswahl von bestimmten Sheets
03.01.2021 13:28:58
bestimmten
Hallo,
mit folgendem Makro, möchte ich nicht mehr das Tabellenblatt "Uebersicht",sondern alle Tabellenblätter die mit einem "B" beginnen übertragen. Diese Tabellen sind beispielhaft wie folgt benannt: B196377 oder B196379 oder B196381.
Nun finde ich keine Lösung für diese Aufgabe und benötige Eure Hilfe. Vielen Dank.
Sub SuchenImport()
Dim objWB As Workbook
Dim vntFile As Variant
Dim StrStreername As String
vntFile = Application.GetOpenFilename("Excel Datei (*.xls; *.xlsx; *.xlsm; *.xlsb), " & "*.xls;  _
*.xlsx; *.xlsm; *.xlsb")
If vntFile  False Then
Set objWB = Workbooks.Open(vntFile)
objWB.Sheets("Uebersicht").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set objWB = Nothing
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = "NEUE DATEI"
strSheetname = InputBox("Bitte geben Sie den Namen ein!", "Neuer Blattname")
If StrPtr(strSheetname) = 0 Then
MsgBox "Eingabe wurde abgeborchen!", vbExclamation, "Neuer Blattname"
ElseIf strSheetname = vbNullString Then
MsgBox "Keine Eingabe vorgenommen!", vbExclamation, "Neuer Blattname"
Else
With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
.Name = strSheetname
End With
MsgBox "Import abgeschlossen", vbInformation, "Daten Import"
End If
End If
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Auswahl von bestimmten Sheets
03.01.2021 13:50:31
bestimmten
Hallo Marko,
so?
Option Explicit

Public Sub SuchenImport()
    
    Dim objWB As Workbook, objWorksheet As Worksheet
    Dim vntFile As Variant
    Dim strSheetname As String
    Dim astrSheets() As String
    Dim ialngIndex As Long
    
    vntFile = Application.GetOpenFilename("Excel Datei (*.xls; *.xlsx; *.xlsm; *.xlsb), " & _
        "*.xls; *.xlsx; *.xlsm; *.xlsb")
    
    If vntFile <> False Then
        
        Set objWB = Workbooks.Open(vntFile)
        
        For Each objWorksheet In objWB.Worksheets
            
            If UCase$(Left$(objWorksheet.Name, 1)) = "B" Then
                
                Redim Preserve astrSheets(ialngIndex)
                
                astrSheets(ialngIndex) = objWorksheet.Name
                
                ialngIndex = ialngIndex + 1
                
            End If
        Next
        
        
        Redim Preserve astrSheets(ialngIndex)
        
        astrSheets(ialngIndex) = "Uebersicht"
        
        objWB.Sheets(astrSheets).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        
        Call objWB.Close(SaveChanges:=False)
        
        Set objWB = Nothing
        
        ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "NEUE DATEI"
        
        strSheetname = InputBox("Bitte geben Sie den Namen ein!", "Neuer Blattname")
        
        If StrPtr(strSheetname) = 0 Then
            
            MsgBox "Eingabe wurde abgeborchen!", vbExclamation, "Neuer Blattname"
            
        ElseIf strSheetname = vbNullString Then
            
            MsgBox "Keine Eingabe vorgenommen!", vbExclamation, "Neuer Blattname"
            
        Else
            
            With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                
                .Name = strSheetname
                
            End With
            
            MsgBox "Import abgeschlossen", vbInformation, "Daten Import"
            
        End If
        
    End If
    
End Sub

Gruß
Nepumuk
Anzeige
Dankeschön
03.01.2021 14:24:53
Marko
Hallo Nepumuk,
Perfekt und vielen Dank.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige