Code zum Durchlaufen von Spalten für bestimmten Wertebereich

Question

Hallo, ich möchte einen Code, der die Spalten von Sheet A durchläuft, und Spalten mit Werten> 0 würden auf Sheet B kopiert werden. Hat einen Code mit Hilfe von einigen Antworten von der vorherigen Forum-Frage, aber immer noch Probleme, da es anscheinend nicht am Paste-Ziel funktioniert! Einige Hilfe würde sehr geschätzt werden. Der Code lautet wie folgt:

Sub TestPasteColumnData3() 

Dim lastcol As Long 
Dim j As Long 

    With Worksheets("WF - L12 (3)") 
    lastcol = .Cells(4, Columns.Count).End(xlToLeft).Column 
     For j = 3 To lastcol 
     If CBool(Application.CountIfs(.Columns(j), ">0")) Then 
      .Columns(j).Copy Destination:=Worksheets("Sheet1").Columns(3) 
     Else 
      MsgBox ("No Value") 
      Exit Sub 
     End If 
     Next 
    End With 

    MsgBox ("Done") 
End Sub 

Answer 1

Sie halten Einfügen in Spalte 3. Versuchen:

.Columns(j).Copy Destination:=Worksheets("Sheet1").Columns(j) 

Answer 2

Sub TestPasteColumnData3() 

Dim lastcol As Long 
Dim j As Long 

    With Worksheets("WF - L12 (3)") 
    lastcol = .Cells(4, Columns.Count).End(xlToLeft).Column 
     For j = 3 To lastcol 
     'change >0 to <>0 and 3 to j   
     If CBool(Application.CountIfs(.Columns(j), "<>0")) Then 
      .Columns(j).Copy Destination:=Worksheets("Sheet1").Columns(j) 
     Else 
      MsgBox ("No Value") 
      Exit Sub 
     End If 
     Next 
    End With 

    MsgBox ("Done") 
End Sub 

Pl 2 Änderungen über Ihr Code funktioniert vorgeschlagen machen.

@Niva Ich bin noch herauszufinden, grundlegenden Grund für Countifs oder CountA nicht die gewünschten Ergebnisse zu geben. Für Ihre unmittelbaren Anforderungen können Sie ein zusätzliches Programm verwenden, um Leerzeichen in Sheet1 zu löschen. Bitte machen Sie es Active Sheet und verwenden Sie das folgende Programm.

Sub DeleteBlankColumns() 

    With Worksheets("Sheet1") 
    Dim lastColumn As Long 
    lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column 
    'MsgBox lastColumn 
    Dim lastRow As Long 
    Dim rng As Range 

    Set rng = ActiveSheet.Cells 

    lastRow = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row 

    'MsgBox lastRow 
    'Step1: Declare your variables. 
    Dim MyRange As Range 
    Dim iCounter As Long 
    'Step 2: Define the target Range. 
    Set MyRange = ActiveSheet.Range(Cells(1, 1), Cells(lastRow, lastColumn)) 

    'Step 3: Start reverse looping through the range. 

    For iCounter = MyRange.Columns.Count To 1 Step -1 
    'Debug.Print iCounter 
    'Step 4: If entire column is empty then delete it. 
     Debug.Print Application.CountA(Columns(iCounter).EntireColumn) = 0 
     If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then 
     Columns(iCounter).Delete 
     End If 
    'Step 5: Increment the counter down 
    Next iCounter 
    End With 
End Sub 

Answer 3

Warum kopieren und einfügen? Ich versuche, Kopieren und Einfügen zu vermeiden, da es auf der Zwischenablage des Betriebssystems beruht, die von anderen Anwendungen verwendet werden kann.

Worksheets("Sheet1").Columns(j).value = Columns(j).value 

auch dies:

Application.CountIfs 

sollte dies sein:

Application.worksheetfunction.CountIf 'Note, don't need countifS for only 1 criteria 

Auch nicht sicher, dass Sie es wirklich zu einem boolean konvertieren.