INCOLLA - TRASPONI: AUTOMATIZZATA

[Menkiolino]

Buongiorno a tutti, vi devo chiedere qualcosa che non penso sia molto complicato ma uso excel molto poco e rischio di perderci un botto di tempo se lo faccio a mano.

In sintesi ho nella colonna A ho questi dati,
nome
cognome
indirizzo
...

e nella colonna B tutti i dati relativi all'utente X (es: mario, rossi, via roma...)

il problema è che questo database è fatto in colonna, ovvero una volta terminati i dati del utente X, ricomincia subito con nome cognome etc dell'utente Y.

Invece a me interesserebbe avere l'intestazione nella prima riga
nome cognome indirizzo

e sotto, divisi per riga, i vari dati.

In pratica bastarebbe prendere ogni riga dei dati dell'utente X, messi in colonna, e fare copia incolla TRASPONI che poi me li mette in riga, ma dovrei farlo per tutti gli utenti quindi rischio di andare lungo.

Spero di essermi spiegato, in ogni caso metto un allegato che chiarisce il da farsi.

Grazie infinite per la vostra disponibilità.

link per download excel

[ricky53]

ciao,
hai scelto un sito non sicuro.
Carica il file con Questo LINK

I dati di tutti gli utenti sono sempre dello stesso numero di righe?

[ricky53]

Ciao,
in attese del tuo file e della risposta alla mia odmanda ... prova questo esempio

Codice: Seleziona tutto

Sub Copia_e_Trasponi()
    Dim UR As Long, I As Long, X As Long, Utenti As Integer, Ripetute As Integer, WS As Worksheet
   
    Set WS = ActiveSheet
    Ripetute = 4 ' <<===== numero di righe dello stesso utente presenti oltre la prima
    X = 2 ' <<====  Riga da cui partono i dati
    Utenti = 0
    UR = WS.Range("AA" & Rows.Count).End(xlUp).Row ' <<===== Cambia "AA" con la tua colonna
    WS.Range(Cells(2, "AA").Address, Cells(UR, 27 + Ripetute + 1).Address).ClearContents ' <<===== Cambia "AA" con la tua colonna
    UR = WS.Range("A" & Rows.Count).End(xlUp).Row
    For I = 2 To UR Step Ripetute + 1
        Utenti = Utenti + 1
        WS.Range("A" & I & ":A" & I + Ripetute).Copy
        Range("AA" & X).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True ' <<==== I dati vengono copiati a partire dalla colonna "AA", cambia in base alle tue esigenze
        X = WS.Range("AA" & Rows.Count).End(xlUp).Row + 1 ' <<===== Cambia "AA" con la tua colonna
    Next I
   
    Set WS = Nothing
    MsgBox "E' stata effettuata la copia dei dati di  " & Utenti & "   utenti", vbInformation
End Sub


Leggi quanto o scritto nel codice !

[Menkiolino]

come fa wetransfer a non essere sicuro... vabbè. Ecco il link http://www.filedropper.com/datidaordinare

Ehm.. do un'occhiata a cosa hai scritto nel codice si.. ma che da li riesco a combinarci qualcosa ne passa.

Comunque provo

[Menkiolino]

Ah scusami, il numero di righe per utente è sempre uguale.

Grazie ancora

[ricky53]

Ciao,
ecco il messaggio dell'antivirus:
Sito o Applicazione WEB Bloccata
Ragione del Blocco: 'Block Web Applications With High Risk'.
Nome applicazione: WeTransfer Channel.

Comunque hai provato il codice che ti ho inviato?

Consiglio: filtra ed elimina le righe che hanno la dicitura "Nuova richiesta di informazioni"
il codice va modificato per copiare la colonna "B".
Devi impostare la variabile "Ripetute" a "11" (le righe totali sono 1 + 11 ripetute, ossia 12 per ogni utente)

[ricky53]

Ciao,
se non vuoi toccare i dati di partenza allora utilizza questo codice che ho adattato allo scopo:

Codice: Seleziona tutto

Sub Copia_e_Trasponi()
    Dim UR As Long, I As Long, X As Long, Utenti As Integer, Ripetute As Integer, WS As Worksheet
   
    Set WS = ActiveSheet
    Ripetute = 12 ' <<===== numero di righe dello stesso utente presenti oltre la prima
    X = 2 ' <<====  Riga da cui partono i dati
    Utenti = 0
    UR = WS.Range("AA" & Rows.Count).End(xlUp).Row ' <<===== Cambia "AA" con la tua colonna
    WS.Range(Cells(2, "AA").Address, Cells(UR, 27 + Ripetute + 1).Address).ClearContents ' <<===== Cambia "AA" con la tua colonna
    UR = WS.Range("A" & Rows.Count).End(xlUp).Row
    For I = 3 To UR Step Ripetute + 1
        Utenti = Utenti + 1
        WS.Range("B" & I + 1 & ":B" & I + Ripetute).Copy
        Range("AA" & X).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True ' <<==== I dati vengono copiati a partire dalla colonna "AA", cambia in base alle tue esigenze
        X = WS.Range("AA" & Rows.Count).End(xlUp).Row + 1 ' <<===== Cambia "AA" con la tua colonna
    Next I
   
    Set WS = Nothing
    MsgBox "E' stata effettuata la copia dei dati di  " & Utenti & "   utenti", vbInformation
End Sub


[Menkiolino]

ehm... è che non poter usare le macro rende tutto più complicato.

Comunque... smanetto nei prossimi giorni per capire come fare.

Grazie comunque

[ricky53]

Ciao,
hai provato il codice che ti ho inviato?

Se i riferimenti delle colonne che hai dato sono effettivamente quelli della tua situazione allora il codice che ti ho inviato dovrebbe fare il suo dovere e ... provalo !!!