Copiare su unica colonna

Question

Salve ho 12 colonne formate da 31 righe li dovrei copiare su un'unica,come posso fare?inoltre e possibile fare questo processo per 32 fogli e ottenere un'unica colonna?

Answer 1

Salve ho 12 colonne formate da 31 righe li dovrei copiare su un'unica,come posso fare?inoltre e possibile fare questo processo per 32 fogli e ottenere un'unica colonna?

Vedi:

http://www.maurogsc.eu/esempiforum14/colonneincolonna.zip

Dove devi modificare questo:

Set shArray = .Worksheets(Array("Foglio1", "Foglio2", "Foglio3", "Foglio4"))

aggiungendo/modificando i nomi dei tuoi fogli.

Se(se) devi fare questa cosa per TUTTI i fogli meno che per il foglio riepilogo, modifica così il codice:

Public Sub m()

    Dim sh As Worksheet

    Dim shRiepilogo As Worksheet

    Dim lRiga As Long

    Dim lCol As Long

    Dim rng As Range

    Set shRiepilogo = ThisWorkbook.Worksheets("Riepilogo")

    On Error Resume Next

    Application.ScreenUpdating = False

    With shRiepilogo

        .Range("A:A").ClearContents

        For Each sh In ThisWorkbook.Worksheets

            If sh.Name <> "Riepilogo" Then

                Set rng = sh.Range("A1").CurrentRegion

                Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)

                For lCol = 1 To 12

                    lRiga = .Range("A" & .Rows.Count).End(xlUp).Row + 1

                    rng.Columns(lCol).Copy

                    .Range("A" & lRiga).PasteSpecial

                    Application.CutCopyMode = False

                Next

                Set rng = Nothing

            End If

        Next

    End With

    Application.ScreenUpdating = True

    Set sh = Nothing

    Set shRiepilogo = Nothing

End Sub

In entrambi i casi incolonno tutto nella colonna A del foglio Riepilogo. Modifica con i tuoi riferimenti.

Answer 2

Io ho fatto in questo modo,però mi da errore,cosa ho sbagliato? allego il fine

https://www.dropbox.com/s/qrouc64xn6883mp/2670dati1.xlsm

Answer 3

Ciao  ciao............,,,

Più efficiente, e come originariamente previsto, sostituisci la riga

            oCol.Add Item:=rngIn, key:=SH.Name

con

                oCol.Add Item:=arrIn, key:=SH.Name

===

Regards,

Norman

Answer 4

Salve ho 12 colonne formate da 31 righe li dovrei copiare su un'unica,come posso fare?inoltre e possibile fare questo processo per 32 fogli e ottenere un'unica colonna?

Ciao ciao............,,

Prova qualcosa del genere:

Alt-F11 per aprire l'editor di VBA

Alt-IMper inserire un nuovo modulo di codice

Nel nuovo modulo vuoto, incolla il seguente codice:

'==========>>

Option Explicit

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

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet, firstSH As Worksheet, destSH As Worksheet

    Dim rngIn As Range

    Dim arrIn As Variant, arrOut() As Variant

    Dim oCol As Collection

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

    Dim x As Long, y As Long, z As Long

    Dim calcMode As Long

    Const primoFoglio As String = "Foglio1"                  '<<==== Modifica

    Const destFoglio As String = "FoglioX"                    '<<==== Modifica

    Const numColonne = 12                                          '<<==== Modifica

    Const numRighe = 31                                            '<<==== Modifica

    Set WB = Workbooks("Pippo.xlsm")                       '<<==== Modifica

    With WB

        Set firstSH = WB.Sheets(primoFoglio)

        Set destSH = .Sheets(destFoglio)

    End With

    Set rngIn = firstSH.Range("A1").Resize(numRighe, numColonne)

    arrIn = rngIn.Value

    Set oCol = New Collection

    oCol.Add Item:=rngIn, key:=firstSH.Name

    For Each SH In WB.Worksheets

        If SH.Name <> primoFoglio And SH.Name <> destFoglio Then

            Set rngIn = SH.Range("A2").Resize(numRighe, numColonne)

            oCol.Add Item:=rngIn, key:=SH.Name

        End If

    Next SH

    i = oCol.Count

    k = numRighe * numColonne * i

    ReDim arrOut(1 To k)

    For j = 1 To oCol.Count

        For x = 1 To numColonne

            For y = 1 To numRighe

                z = z + 1

                arrOut(z) = oCol(j)(y, x)

            Next y

        Next x

    Next j

    With Application

        calcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

    destSH.Range("A2").Resize(z).Value = Application.Transpose(arrOut)

    With Application

        .Calculation = calcMode

        .ScreenUpdating = True

    End With

End Sub

'<<==========

Alt-Q per chiudere l'editor di VBA e tornare a Excel.

Alt-F8 per aprire la finestrina macro

Seleziona Tester | Esegui

===

Regards,

Norman

Answer 5

ammettendo che i dati iniziano in B2:

 =SCARTO($B$2;RESTO(RIF.RIGA(A31);31);TRONCA((RIF.RIGA(A31))/31)-1)

e trascini in basso

per il discorso dei fogli, non ho capito