Wie man ein Blatt vermeidet, wenn wir ein Makro laufen lassen kombiniert Daten von vielen Blättern in ein einzelnes Blatt

Question

Ich bin neu im Makro, aber habe eine Grundidee, wie es funktioniert oder wie ich kleine VBA Codes schreiben kann.

Ist es möglich, mehr als 1 Blätter zu vermeiden, wenn ich unten Makro verwenden, welche Daten aus verschiedenen Blättern auf ein Blatt tatsächlich

Import

VBA CODE

Option Explicit 
Public Sub CombineDataFromAllSheets() 

Dim wksSrc As Worksheet, wksDst As Worksheet 
Dim rngSrc As Range, rngDst As Range 
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long 
Dim Strname As String 

'Notes: "Src" is short for "Source", "Dst" is short for "Destination" 

'Set references up-front 
Set wksDst = ThisWorkbook.Worksheets("Import") 
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)! 
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)! 

'Set the initial destination range 
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1) 

'Loop through all sheets 
For Each wksSrc In ThisWorkbook.Worksheets 

    'Make sure we skip the "Import" destination sheet! 
    Strname = UCase(wksSrc.Name) 
    If Strname <> "Import" And _ 
    Strname <> "Import2" Then 

     'Identify the last occupied row on this sheet 
     lngSrcLastRow = LastOccupiedRowNum(wksSrc) 

     'Store the source data then copy it to the destination range 
     With wksSrc 
      Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol)) 
      rngSrc.Copy Destination:=rngDst 
     End With 

     'Redefine the destination range now that new data has been added 
     lngDstLastRow = LastOccupiedRowNum(wksDst) 
     Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1) 

    End If 

Next wksSrc 
End Sub 


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'INPUT  : Sheet, the worksheet we'll search to find the last row 
'OUTPUT  : Long, the last occupied row 
'SPECIAL CASE: if Sheet is empty, return 1 
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long 
    Dim lng As Long 
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then 
     With Sheet 
      lng = .Cells.Find(What:="*", _ 
           After:=.Range("A1"), _ 
           Lookat:=xlPart, _ 
           LookIn:=xlFormulas, _ 
           SearchOrder:=xlByRows, _ 
           SearchDirection:=xlPrevious, _ 
           MatchCase:=False).Row 
     End With 
    Else 
     lng = 1 
    End If 
    LastOccupiedRowNum = lng 
End Function 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'INPUT  : Sheet, the worksheet we'll search to find the last column 
'OUTPUT  : Long, the last occupied column 
'SPECIAL CASE: if Sheet is empty, return 1 
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long 
    Dim lng As Long 
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then 
     With Sheet 
      lng = .Cells.Find(What:="*", _ 
           After:=.Range("A1"), _ 
           Lookat:=xlPart, _ 
           LookIn:=xlFormulas, _ 
           SearchOrder:=xlByColumns, _ 
           SearchDirection:=xlPrevious, _ 
           MatchCase:=False).Column 
     End With 
    Else 
     lng = 1 
    End If 
    LastOccupiedColNum = lng 
End Function 

Zum Beispiel Ich habe 5 Blätter genannt kopieren in einem Excel sind sie

Sheet1. Control Sheet (mehr wie Dashboard/UI)
Sheet2. Importieren (Wo Daten kopiert werden müssen)
Sheet3. Vergleich (Keine Notwendigkeit, Daten von diesem Blatt zu kopieren)
Sheet4. CSV-Datei 1 (Alle verfügbaren Daten werden nach IMPORT Sheet kopiert)
Sheet5. CSV-Datei 2 (Alle verfügbaren Daten Blatt IMPORT kopiert werden)

jetzt, wenn der Benutzer 6 die Abfrage nur Daten aus Blech 5 und Blatt ausführen zu 2 Blatt kopiert wird (Import)

I verwendet

Strname = UCase(wksSrc.Name) 
If Strname <> "Import" And _ 
Strname <> "Comparison" And _ 
Strname <> "Control Sheet" Then 

Aber das funktioniert eigentlich nicht und kopieren Sie einfach alles unter allen 5 Blättern.

Bitte helfen Sie mir dabei.

Vielen Dank im Voraus

Answer 1

A Select Case-Anweisung ist gut geeignet für mehrere Vergleiche zu Wert Handhabung.

Select Case UCase(wksSrc.Name) 
     Case UCase("Import"), UCase("Comparison"), UCase("Control Sheet") 

     Case Else 

    End Select 

---

Hier verwende ich Filter es Textvergleich Fähigkeit ist.

Ich bevorzuge es, den Quellbereich an eine Hilfsfunktion zu übergeben. Dies macht das Debuggen sehr einfach.

Public Sub CombineDataFromAllSheets2() 
    Dim LastUsedCell As Range, ws As Worksheet 

    For Each ws In ThisWorkbook.Worksheets 
     With ws 
      If Filter(Array("Import", "Comparison", "Control Sheet"), .Name, True, vbTextCompare) = -1 Then 

       Set LastUsedCell = getLastUsedCell(ws) 
       If LastUsedCell Is Nothing Then 
        MsgBox "No Cells Found on Worksheet: " & ws.Name, vbInformation, "Worksheet Skipped" 
       Else 
        ImportRange .Range(.Cells(2, 1), LastUsedCell) 
       End If 

      End If 
     End With 
    Next 
End Sub 

Public Sub ImportRange(Source As Range) 
    With ThisWorkbook.Worksheets("Import") 
     With .Range("A" & .Rows.Count).End(xlUp) 
      Source.Copy Destination:=.Offset(1) 
     End With 
    End With 
End Sub 

Public Function getLastUsedCell(ws As Worksheet) As Range 
    Set getLastUsedCell = ws.Cells.Find(What:="*", After:=ws.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False) 
End Function