Copia/Incolla tra fogli - Da orizzontale a verticale, associandoli a voci specifiche

Question

Ciao a tutte/i. In un foglio excel ho alcune migliaia righe che dovrei ricopire su altro foglio, con una logica leggermente diversa.

In pratica:

• sul foglio 1 ciascuna riga corrisponde alle configurazioni di 1 singolo utente
• sul foglio 2 dovrei riportare in verticale queste voci, associandole all'utente di riferimento.

Probabilmente dovrei utilizzare una macro?

Ho caricato un esempio a questo link.

Grazie mille per l'aiuto.

Answer 1

Ciao Francesco,

Ciao Norman, grazie per la tua risposta.

La struttura dei dati è quella che vedi nell'ultimo file. Naturalmente, le 4 righe erano solo un esempio :-) L'esigenza è quella indicata nel post originario (nel quale già parlavo di un file da migliaia di righe):

• sul foglio 1 ciascuna riga riporta le configurazioni di 1 singolo utente
• sul foglio 2 dovrei riportare in verticale le singole abilitazioni.

Faccio un esempio concreto:

• nel foglio 1, l'utente "*** L'indirizzo e-mail viene rimosso per motivi di privacy *** Nome1 Cognome1" ha le abilitazioni 1,2,3,4,5,6,26 (tutte indicante nella riga 2)
• nel foglio 2 dovrebbe essere riportato in verticale

  	*** L'indirizzo e-mail viene rimosso per motivi di privacy ***	Nome 1	Cognome 1	ABILITAZIONE 1
  	*** L'indirizzo e-mail viene rimosso per motivi di privacy ***	Nome 1	Cognome 1	ABILITAZIONE 2
  	---	---	---	---
  	*** L'indirizzo e-mail viene rimosso per motivi di privacy ***	Nome 1	Cognome 1	ABILITAZIONE 3
  	---	---	---	---
  	*** L'indirizzo e-mail viene rimosso per motivi di privacy ***	Nome 1	Cognome 1	ABILITAZIONE 4
  	---	---	---	---
  	*** L'indirizzo e-mail viene rimosso per motivi di privacy ***	Nome 1	Cognome 1	ABILITAZIONE 5
  	---	---	---	---
  	*** L'indirizzo e-mail viene rimosso per motivi di privacy ***	Nome 1	Cognome 1	ABILITAZIONE 6
  	---	---	---	---
  	*** L'indirizzo e-mail viene rimosso per motivi di privacy ***	Nome 1	Cognome 1	ABILITAZIONE 26
  	---	---	---	---

Spero che ora sia stato un pò più chiaro.

Grazie davvero per l'aiuto.

Prova la seguente leggera modifica del mio codice:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim srcSH As Worksheet, destSH As Worksheet 

Dim srcRng As Range, destRng As Range, emailRng As Range 

Dim rCell As Range 

Dim arrIn As Variant, arrOut() As Variant 

Dim i As Long, j As Long, k As Long, iCtr As Long 

Dim LRow As Long, LCol As Long 

Const sFoglio\_Sorgente As String = **"Foglio1"                     '<<==== Modifica** 

Const sFoglio\_Destinazione As String = **"Foglio2"               '<<==== Modifica** 

Const sDestinazione As String = **"A2"**                

Set WB = ThisWorkbook 

With WB 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

With srcSH 

    LRow = LastRow(srcSH, .Columns("A:A")) 

    LCol = LastCol(srcSH, .Rows(1)) 

    Set srcRng = .Range("A2").Resize(LRow, LCol) 

End With 

Set destRng = destSH.Range(sDestinazione) 

arrIn = srcRng.Value 

ReDim arrOut(1 To LRow \* LCol, 1 To 4) 

For i = 1 To UBound(arrIn) 

    For j = 4 To UBound(arrIn, 2) 

        If Not IsEmpty(arrIn(i, j)) Then 

            iCtr = iCtr + 1 

            For k = 1 To 3 

                arrOut(iCtr, k) = arrIn(i, k) 

            Next k 

            arrOut(iCtr, 4) = arrIn(i, j) 

        End If 

    Next j 

Next i 

On Error GoTo XIT 

Application.ScreenUpdating = False 

With destRng 

    .Resize(UBound(arrOut), UBound(arrOut, 2)).Value = arrOut 

    srcRng.Cells(1).Offset(-1).Resize(, 4).Copy Destination:=.Offset(-1) 

    .Offset(-1, 3).Value = "TIPO ABILITAZIONE" 

End With 

On Error Resume Next 

Set emailRng = destSH.Range(destRng, destRng.End(xlDown)) 

For Each rCell In emailRng.Cells 

    With rCell 

        .Hyperlinks.Add Anchor:=rCell, Address:=.Text, TextToDisplay:=.Text 

    End With 

Next rCell 

On Error GoTo XIT

destRng.EntireColumn.Resize(, 4).AutoFit 

Call MsgBox(Prompt:="Finito", \_ 

    Buttons:=vbInformation, \_ 

    Title:="REPORT") 

XIT:

Application.ScreenUpdating = True 

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, \_ 

Optional minRow As Long = 1) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastRow = Rng.Find(What:="\*", \_ 

    after:=Rng.Cells(1), \_ 

    Lookat:=xlPart, \_ 

    LookIn:=xlFormulas, \_ 

    SearchOrder:=xlByRows, \_ 

    SearchDirection:=xlPrevious, \_ 

    MatchCase:=False).Row 

On Error GoTo 0 

If LastRow < minRow Then 

    LastRow = minRow 

End If 

End Function

'--------->>

Public Function LastCol(SH As Worksheet, _

             Optional Rng As Range) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastCol = Rng.Find(What:="\*", \_ 

                   after:=Rng.Cells(1), \_ 

                   Lookat:=xlPart, \_ 

                   LookIn:=xlFormulas, \_ 

                   SearchOrder:=xlByColumns, \_ 

                   SearchDirection:=xlPrevious, \_ 

                   MatchCase:=False).Column 

On Error GoTo 0 

End Function

'<<========

Potresti scaricare il mio file di [prova Francesco20230127.xlsm

Eseguendo questo codice con i tuoi dati, ottengo un report di output di 19593 righe che inizia come segue:

  [![Immagine](https://learn-attachment.microsoft.com/api/attachments/50f8c55b-62d2-4c8d-8f50-7f7da7407f90?platform=QnA"https://learn-attachment.microsoft.com/api/attachments/132d94c7-657a-4d24-a1ac-7eaa36850e86?platform=QnA" rel="ugc nofollow">

Answer 2

Ciao Francesco,

Grazie mille! :-) Sei un dragoooo

Sono lieto che il codice ti sia stato utile e ti ringrazio per il cortese riscontro.

Alla prossima.

===

Regards,

Norman

Answer 3

Grazie mille! :-) Sei un dragoooo

Answer 4

Ciao Norman, grazie per la tua risposta.

La struttura dei dati è quella che vedi nell'ultimo file. Naturalmente, le 4 righe erano solo un esempio :-) L'esigenza è quella indicata nel post originario (nel quale già parlavo di un file da migliaia di righe):

• sul foglio 1 ciascuna riga riporta le configurazioni di 1 singolo utente
• sul foglio 2 dovrei riportare in verticale le singole abilitazioni.

Faccio un esempio concreto:

• nel foglio 1, l'utente "******@001.com Nome1 Cognome1" ha le abilitazioni 1,2,3,4,5,6,26 (tutte indicante nella riga 2)
• nel foglio 2 dovrebbe essere riportato in verticale

  	******@001.com	Nome 1	Cognome 1	ABILITAZIONE 1
  	******@001.com	Nome 1	Cognome 1	ABILITAZIONE 2
  	---	---	---	---
  	******@001.com	Nome 1	Cognome 1	ABILITAZIONE 3
  	---	---	---	---
  	******@001.com	Nome 1	Cognome 1	ABILITAZIONE 4
  	---	---	---	---
  	******@001.com	Nome 1	Cognome 1	ABILITAZIONE 5
  	---	---	---	---
  	******@001.com	Nome 1	Cognome 1	ABILITAZIONE 6
  	---	---	---	---
  	******@001.com	Nome 1	Cognome 1	ABILITAZIONE 26
  	---	---	---	---

Spero che ora sia stato un pò più chiaro.

Grazie davvero per l'aiuto.