ripetizione macro colonne

Hai un problema con Excel?

Nuova discussione

ripetizione macro colonne
di kikkigellu (utente non iscritto) data: 18/01/2016 01:54:47
Ciao a tutti,
ho un problema con un report e ci sto sbattendo la testa senza risultati
nella colonna A ho un elenco di nomi e nelle colonne B, C, D etc un'elenco di date (365 colonne)
devo selezionare tutto l'insieme, copiare con il trasponi in modo da avere nella prima riga (A1, B1, C1,...) l'elenco dei fornitori e sotto di questi, le date corrispettive.
1° problema: eliminare le celle vuote per ogni colonna
2° problema: per saltare il 1° problema pensavo di fare una macro che filtrasse ogni colonna, selezionasse i valori pieni e li copiasse (sempre in colonna) in un nuovo foglio.

Avendo però circa 200 e passa colonne, volevo sapere come poter rendere automatica la macro di filtro A:A-seleziono valori-copio e incollo valori in A2 su nuovo foglio-tolgo il filtro; filtro B:B-seleziono valori etc etc etc

A voi una bozza di macro registrata:

Grazie a tutti in anticipo! :)

Range("A4:NC4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Foglio2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Foglio3").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$OI$367").AutoFilter Field:=1, Criteria1:="<>"
    Columns("A:A").Select
    Selection.Copy
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Cut
    ActiveSheet.Range("$A$1:$OI$367").AutoFilter Field:=1, Criteria1:="<>"
    Range("A15:A142").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Foglio4").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Foglio3").Select
    ActiveSheet.Range("$A$1:$OI$367").AutoFilter Field:=1
    Range("B:B").Select
    ActiveSheet.Range("$A$1:$OI$367").AutoFilter Field:=2, Criteria1:="<>"
    Range("B16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Foglio4").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").EntireColumn.AutoFit
    Range("B2").Select
    ActiveSheet.Paste
    Columns("B:B").EntireColumn.AutoFit
End Sub

di Mister_x (utente non iscritto) data: 18/01/2016 10:46:56
ciao

una sub() per questo lavoro buttata giu' al momento, si potrebbe migliorare
traspone da foglio1 in riga a foglio2 in colonna saltando le celle vuote

allego file

PS sarebbe sempre utile allegare un file vostro

ciao

Option Explicit
Sub trasponiRigaColonna()
Dim F1 As String, F2 As String
Dim Vriga As Range
Dim Vcella As Variant
Dim i As Long, Nriga As Long
F1 = "Foglio1"
F2 = "Foglio2"
For i = 1 To Sheets(F1).Cells(Rows.Count, 1).End(xlUp).Row
 Set Vriga = Sheets(F1).Range("A" & i & ":OZ" & i)
 Nriga = 1
 For Each Vcella In Vriga
   If Vcella <> "" Then
     Sheets(F2).Cells(Nriga, i) = Vcella
     Nriga = Nriga + 1
   End If
 Next
Next i
 Set Vriga = Nothing
End Sub

di kikkigellu (utente non iscritto) data: 19/01/2016 02:08:35
Ciao Mister_x,

funziona alla grande! è proprio quello di cui avevo bisogno!

Grazie mille :)

Vuoi Approfondire?