Comment éviter une feuille lorsque nous exécutons une macro combine les données de nombreuses feuilles dans une seule feuille

Question

Je suis novice en macro, mais j'ai une idée de base de la façon dont cela fonctionne ou comme capable d'écrire de petits codes VBA.

Est-il possible d'éviter plus de 1 feuilles lors de l'utilisation ci-dessous macro qui copie en fait des données de différentes feuilles à une feuille appelée Importation

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 

Par exemple J'ai 5 feuilles dans un Excel, ils sont

Feuille1. Feuille de contrôle (plus comme un tableau de bord/interface utilisateur)
Sheet2. Importation (où les données doivent être copiées)
Sheet3. Comparaison (Pas besoin de copier les données de cette fiche)
Sheet4. Fichier CSV 1 (Toutes les données disponibles seront copiées dans la feuille IMPORT )
Feuille5. fichier CSV 2 (toutes les données disponibles seront copiées sur IMPORT feuille)

maintenant lorsque l'utilisateur d'exécuter la requête uniquement les données de la feuille 5 et la feuille 6 sont copiés à la feuille 2 (Importer)

je

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

Mais cela ne fonctionne pas et il suffit de copier tout ce qui est disponible sous les 5 feuilles.

Veuillez m'aider à ce sujet.

Merci à l'avance

Answer 1

A Select déclaration de cas sont bien adaptés pour la manipulation de plusieurs comparisions à la valeur.

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

     Case Else 

    End Select 

---

Ici, j'utiliser Filter pour sa capacité de comparaison de texte.

Je préfère passer la gamme Source à une fonction d'aide. Cela rend le débogage très facile.

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