VBA Auswahl von bestimmten Sheets

Forumthread: 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

AW: VBA Auswahl von bestimmten Sheets

03.01.2021 13:50:31

bestimmten
Dankeschön

03.01.2021 14:24:53

Marko

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

Dankeschön

03.01.2021 14:24:53

Marko

Hallo Nepumuk,
Perfekt und vielen Dank.

Beliebteste Forumthreads (12 Monate)

VBA Auswahl von bestimmten Sheets

Forumthread: VBA Auswahl von bestimmten Sheets

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread