Bear with me here. I have been working on this macro for some time now. The goal is to copy cells "C" through "y" to the cells listed on worksheet "output." The cells that are column headers for an autofilter table and are grouped together based on a higher order.
This macro will work with every column and cell visible, however, if groupings are closed and/or the autofilter is active, the macro does not function. The macro does not break either, the macro will run with no results.
How can this macro worth with any number of autofilters active and some groupings closed.
SOrry for no HTML code, work does not allow.
EDIT: added Code tags - you don't need the HTML maker for that - Moderator
This macro will work with every column and cell visible, however, if groupings are closed and/or the autofilter is active, the macro does not function. The macro does not break either, the macro will run with no results.
How can this macro worth with any number of autofilters active and some groupings closed.
SOrry for no HTML code, work does not allow.
Code:
Sub Button86_Click()
Sheets("Output").Range("C501:c513,d501:d513,e501:e513").ClearContents
Dim c As Long, d As Long, e As Long, f As Long, g As Long, h As Long, i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long, r As Long, s As Long, t As Long, u As Long, v As Long, w As Long, x As Long, y As Long
With Sheets("Database")
On Error Resume Next
c = Application.WorksheetFunction.CountIf(.Range("C7:C200").SpecialCells(xlVisible), "X")
d = Application.WorksheetFunction.CountIf(.Range("D7:D200").SpecialCells(xlVisible), "X")
e = Application.WorksheetFunction.CountIf(.Range("E7:E200").SpecialCells(xlVisible), "X")
f = Application.WorksheetFunction.CountIf(.Range("F7:F200").SpecialCells(xlVisible), "X")
g = Application.WorksheetFunction.CountIf(.Range("G7:g200").SpecialCells(xlVisible), "X")
h = Application.WorksheetFunction.CountIf(.Range("h7:h200").SpecialCells(xlVisible), "X")
i = Application.WorksheetFunction.CountIf(.Range("i7:i200").SpecialCells(xlVisible), "X")
j = Application.WorksheetFunction.CountIf(.Range("j7:j200").SpecialCells(xlVisible), "X")
k = Application.WorksheetFunction.CountIf(.Range("k7:k200").SpecialCells(xlVisible), "X")
l = Application.WorksheetFunction.CountIf(.Range("l7:l200").SpecialCells(xlVisible), "X")
m = Application.WorksheetFunction.CountIf(.Range("m7:m200").SpecialCells(xlVisible), "X")
n = Application.WorksheetFunction.CountIf(.Range("n7:n200").SpecialCells(xlVisible), "X")
o = Application.WorksheetFunction.CountIf(.Range("o7:o200").SpecialCells(xlVisible), "X")
p = Application.WorksheetFunction.CountIf(.Range("p7:p200").SpecialCells(xlVisible), "X")
q = Application.WorksheetFunction.CountIf(.Range("q7:q200").SpecialCells(xlVisible), "X")
r = Application.WorksheetFunction.CountIf(.Range("r7:r200").SpecialCells(xlVisible), "X")
s = Application.WorksheetFunction.CountIf(.Range("s7:s200").SpecialCells(xlVisible), "X")
t = Application.WorksheetFunction.CountIf(.Range("t7:t200").SpecialCells(xlVisible), "X")
u = Application.WorksheetFunction.CountIf(.Range("u7:u200").SpecialCells(xlVisible), "X")
v = Application.WorksheetFunction.CountIf(.Range("v7:v200").SpecialCells(xlVisible), "X")
w = Application.WorksheetFunction.CountIf(.Range("w7:w200").SpecialCells(xlVisible), "X")
x = Application.WorksheetFunction.CountIf(.Range("x7:x200").SpecialCells(xlVisible), "X")
y = Application.WorksheetFunction.CountIf(.Range("y7:y200").SpecialCells(xlVisible), "X")
If c > 0 Then
.Range("c6").Copy
Sheets("Output").Range("C502").PasteSpecial Transpose:=True
ElseIf c = 0 Then
Resume Next
End If
If d > 0 Then
.Range("d6").Copy
Sheets("Output").Range("C503").PasteSpecial Transpose:=True
ElseIf d = 0 Then
Resume Next
End If
If e > 0 Then
.Range("e6").Copy
Sheets("Output").Range("C504").PasteSpecial Transpose:=True
ElseIf e = 0 Then
Resume Next
End If
If f > 0 Then
.Range("f6").Copy
Sheets("Output").Range("C505").PasteSpecial Transpose:=True
ElseIf f = 0 Then
Resume Next
End If
If g > 0 Then
.Range("g6").Copy
Sheets("Output").Range("C506").PasteSpecial Transpose:=True
ElseIf g = 0 Then
Resume Next
End If
If h > 0 Then
.Range("h6").Copy
Sheets("Output").Range("C507").PasteSpecial Transpose:=True
ElseIf h = 0 Then
Resume Next
End If
If i > 0 Then
.Range("i6").Copy
Sheets("Output").Range("C508").PasteSpecial Transpose:=True
ElseIf i = 0 Then
Resume Next
End If
If j > 0 Then
.Range("j6").Copy
Sheets("Output").Range("C501").PasteSpecial Transpose:=True
ElseIf j = 0 Then
Resume Next
End If
If k > 0 Then
.Range("K6").Copy
Sheets("Output").Range("D502").PasteSpecial Transpose:=True
ElseIf k = 0 Then
Resume Next
End If
If l > 0 Then
.Range("l6").Copy
Sheets("Output").Range("D503").PasteSpecial Transpose:=True
ElseIf l = 0 Then
Resume Next
End If
If m > 0 Then
.Range("m6").Copy
Sheets("Output").Range("D504").PasteSpecial Transpose:=True
ElseIf m = 0 Then
Resume Next
End If
If n > 0 Then
.Range("n6").Copy
Sheets("Output").Range("D505").PasteSpecial Transpose:=True
ElseIf n = 0 Then
Resume Next
End If
If o > 0 Then
.Range("o6").Copy
Sheets("Output").Range("D506").PasteSpecial Transpose:=True
ElseIf o = 0 Then
Resume Next
End If
If p > 0 Then
.Range("p6").Copy
Sheets("Output").Range("D507").PasteSpecial Transpose:=True
ElseIf p = 0 Then
Resume Next
End If
If q > 0 Then
.Range("q6").Copy
Sheets("Output").Range("D508").PasteSpecial Transpose:=True
ElseIf q = 0 Then
Resume Next
End If
If r > 0 Then
.Range("r6").Copy
Sheets("Output").Range("D509").PasteSpecial Transpose:=True
ElseIf r = 0 Then
Resume Next
End If
If s > 0 Then
.Range("s6").Copy
Sheets("Output").Range("D510").PasteSpecial Transpose:=True
ElseIf s = 0 Then
Resume Next
End If
If t > 0 Then
.Range("t6").Copy
Sheets("Output").Range("D501").PasteSpecial Transpose:=True
ElseIf t = 0 Then
Resume Next
End If
If u > 0 Then
.Range("U6").Copy
Sheets("Output").Range("E502").PasteSpecial Transpose:=True
ElseIf u = 0 Then
Resume Next
End If
If v > 0 Then
.Range("v6").Copy
Sheets("Output").Range("E503").PasteSpecial Transpose:=True
ElseIf v = 0 Then
Resume Next
End If
If w > 0 Then
.Range("w6").Copy
Sheets("Output").Range("E504").PasteSpecial Transpose:=True
ElseIf w = 0 Then
Resume Next
End If
If x > 0 Then
.Range("x6").Copy
Sheets("Output").Range("E505").PasteSpecial Transpose:=True
ElseIf x = 0 Then
Resume Next
End If
If y > 0 Then
.Range("y6").Copy
Sheets("Output").Range("E501").PasteSpecial Transpose:=True
ElseIf y = 0 Then
Resume Next
End If
End With
End Sub
EDIT: added Code tags - you don't need the HTML maker for that - Moderator