Sélection uniquement des cellules avec la valeur VBA

Question

J'ai le code ci-dessous et fonctionne très bien, mais je veux seulement copier des cellules avec des valeurs. J'ai des données vides au milieu, car je vais supprimer cela n'a pas de sens pour les copier aussi.

Sub FindAgain() 
' 
' FindAgain Macro 
' 
    Dim Ws As Worksheet 
    Dim LastRow As Long 

    AC = ActiveCell.Column 
    Set Ws = Worksheets("Sheet1") 
    LastRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row 
    Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _ 
     :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ 
     False, SearchFormat:=False).Activate 
    ActiveCell.Offset(1, 0).Select 
    Range(ActiveCell, Cells(LastRow, AC)).Select 

End Sub 

Une idée de comment je peux mieux l'écrire? Avec boucle peut-être? Merci!

Answer 1

Je suppose qu'après Range(ActiveCell, Cells(LastRow, AC)).Select, vous voyez une zone sélectionnée que vous souhaitez copier en ignorant les cellules vides. Une façon d'aller à ce sujet est de parcourir toutes les cellules Selection, vérifier si elles ne sont pas vides et les copier:

Dim c As Range 
Dim i As Long 

' store current row for every column separately 
Dim arrRowInCol() As Long 
ReDim arrRowInCol(Selection.Column To Selection.Column + Selection.Columns.Count - 1) 
For i = LBound(arrRowInCol) To UBound(arrRowInCol) 
    ' init the first row for each column 
    arrRowInCol(i) = Selection.Row 
Next i 

For Each c In Selection 
    If Len(Trim(c)) <> 0 Then 
     c.Copy Destination:=Sheets("Sheet2").Cells(arrRowInCol(c.Column), c.Column) 
     arrRowInCol(c.Column) = arrRowInCol(c.Column) + 1 
    End If 
Next c 

Answer 2

Je vais commencer par votre code, qui tente en fait de sélectionner les plages. Voilà ce que j'ai construit sur elle:

Option Explicit 

Public Sub FindMe() 

    Dim my_range   As Range 
    Dim temp_range   As Range 

    Dim l_counter   As Long 
    Dim my_list    As Object 
    Dim l_counter_start  As Long 


    Set my_list = New Collection 

    l_counter_start = Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _ 
     :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ 
     False, SearchFormat:=False).Row + 1 

    For l_counter = l_counter_start To Worksheets("sheet1").Cells(Rows.Count, "B").End(xlUp).Row 
     If Cells(l_counter, 2) <> "" Then my_list.Add (l_counter) 
    Next l_counter 

    For l_counter = 1 To my_list.Count 
     Set temp_range = Range(Cells(my_list(l_counter), 2), Cells(my_list(l_counter), 4)) 

     If my_range Is Nothing Then 
      Set my_range = temp_range 
     Else 
      Set my_range = Union(my_range, temp_range) 
     End If 
    Next l_counter 

    my_range.Select 

End Sub 

Il fonctionne sur un scénario comme celui-ci:

Quasiment il fonctionne comme ceci:

• Nous déclarons deux gammes.
• La plage my_range est celle à sélectionner à la fin.
• La plage temp_range n'est donnée que s'il y a une valeur dans la deuxième colonne.
• Ensuite, il y a une union des deux plages, et my_range est sélectionné à la fin du code.

Answer 3

trouvé un moyen de faire ce que je veux: au moins travaille, je suis Newby donc, pour vous les gars peut sembler drôle ou mauvais, pour moi est grand = D

Sub FindAgain() 
' 
' FindAgain Macro 
' 
Dim Ws As Worksheet 
Dim LastRow As Long 
Dim c As Range 
Dim i As Integer 
Dim j As Integer 

AC = ActiveCell.Column 
Set Ws = Worksheets("Sheet1") 
LastRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row 
i = 15 
j = 7 
Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _ 
     :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ 
     False, SearchFormat:=False).Activate 
ActiveCell.Offset(1, 0).Select 
Range(ActiveCell, Cells(LastRow, AC)).Select 

For Each c In Selection 
    If Len(Trim(c)) <> "" Then 
     c.Copy Destination:=Sheets("Sheet1").Cells(i, j) 
    End If 

    If c = "" Then 
    i = i 
    Else 
    i = i + 1 
    End If 
    j = j 

Next c 

End Sub