Condividi:        

Come copiare in automatico il contenuto di più celle

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Re: Come copiare in automatico il contenuto di più celle

Postdi scossa » 21/07/13 09:36

danibi60 ha scritto:Le colonne B-C-E-H saranno sempre riempite di volta in volta con testi che variano (te ne allego un esempio) e lo saranno sempre.

Non niente sfondo giallo, solo valori.


Questo il codice da copiare in un modulo standard (Modulo1):

Codice: Seleziona tutto
'---------------------------------------------------------------------------------------
' Procedure : Ricopia
' Author    : scossa
' Date      : 20/07/2013
' Purpose   :
'---------------------------------------------------------------------------------------
'
Public Sub Ricopia()

  Dim wb As Workbook
  Dim ws As Worksheet
  Dim rng As Range
  Dim rngFr As Range
  Dim rngTo As Range
  Dim cella As Range
  Dim bCalc As XlCalculation
 
  With Application
    bCalc = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With
   
  Set wb = ThisWorkbook
  Set ws = wb.ActiveSheet
  Set rng = ws.Range("A1").CurrentRegion '.Resize(, 8)
  Set rngTo = ws.Range("A31")
  rngTo.CurrentRegion.ClearContents
  On Error Resume Next
  Set rngFr = rng.Columns(1).Offset(0, 8).SpecialCells(xlCellTypeConstants, xlTextValues)
  If Err.Number = 0 Then
    Set rng = Intersect(rngFr.EntireRow, rng)
    rng.Copy rngTo
  End If
  Set rng = ws.Range("L1").CurrentRegion '.Resize(, 8)
  Err.Clear
  Set rngFr = rng.Columns(1).Offset(0, 8).SpecialCells(xlCellTypeConstants, xlTextValues)
  If Err.Number = 0 Then
    Set rng = Intersect(rngFr.EntireRow, rng)
    rng.Copy rngTo.Offset(rngTo.CurrentRegion.Rows.Count)
  End If
  'set rngto = rngto.CurrentRegion.Resize(.
  On Error GoTo 0
  rngTo.CurrentRegion.ClearFormats 'per eliminare il formato
  With Application
    .Calculation = bCalc
    .ScreenUpdating = True
  End With
   
  Set rng = Nothing
  Set rngFr = Nothing
  Set rngTo = Nothing
  Set ws = Nothing
  Set wb = Nothing

End Sub



Cancella tutto il codice presente nel modulo di Foglio1 tranne:

Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Me.Range("I1:I25,T1:T25")) Is Nothing Then
    Application.EnableEvents = False
    Call Ricopia
    Application.EnableEvents = True
  End If
End Sub


Cancella tutti i codici degli altri moduli (Modulo2, Modulo3 etc.)
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 427
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Sponsor
 

Re: Come copiare in automatico il contenuto di più celle

Postdi danibi60 » 21/07/13 09:59

scossa ha scritto:
danibi60 ha scritto:Le colonne B-C-E-H saranno sempre riempite di volta in volta con testi che variano (te ne allego un esempio) e lo saranno sempre.

Non niente sfondo giallo, solo valori.


Questo il codice da copiare in un modulo standard (Modulo1):

Codice: Seleziona tutto
'---------------------------------------------------------------------------------------
' Procedure : Ricopia
' Author    : scossa
' Date      : 20/07/2013
' Purpose   :
'---------------------------------------------------------------------------------------
'
Public Sub Ricopia()

  Dim wb As Workbook
  Dim ws As Worksheet
  Dim rng As Range
  Dim rngFr As Range
  Dim rngTo As Range
  Dim cella As Range
  Dim bCalc As XlCalculation
 
  With Application
    bCalc = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With
   
  Set wb = ThisWorkbook
  Set ws = wb.ActiveSheet
  Set rng = ws.Range("A1").CurrentRegion '.Resize(, 8)
  Set rngTo = ws.Range("A31")
  rngTo.CurrentRegion.ClearContents
  On Error Resume Next
  Set rngFr = rng.Columns(1).Offset(0, 8).SpecialCells(xlCellTypeConstants, xlTextValues)
  If Err.Number = 0 Then
    Set rng = Intersect(rngFr.EntireRow, rng)
    rng.Copy rngTo
  End If
  Set rng = ws.Range("L1").CurrentRegion '.Resize(, 8)
  Err.Clear
  Set rngFr = rng.Columns(1).Offset(0, 8).SpecialCells(xlCellTypeConstants, xlTextValues)
  If Err.Number = 0 Then
    Set rng = Intersect(rngFr.EntireRow, rng)
    rng.Copy rngTo.Offset(rngTo.CurrentRegion.Rows.Count)
  End If
  'set rngto = rngto.CurrentRegion.Resize(.
  On Error GoTo 0
  rngTo.CurrentRegion.ClearFormats 'per eliminare il formato
  With Application
    .Calculation = bCalc
    .ScreenUpdating = True
  End With
   
  Set rng = Nothing
  Set rngFr = Nothing
  Set rngTo = Nothing
  Set ws = Nothing
  Set wb = Nothing

End Sub



Cancella tutto il codice presente nel modulo di Foglio1 tranne:

Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Me.Range("I1:I25,T1:T25")) Is Nothing Then
    Application.EnableEvents = False
    Call Ricopia
    Application.EnableEvents = True
  End If
End Sub


Cancella tutti i codici degli altri moduli (Modulo2, Modulo3 etc.)


Perdonami Scossa, ma cosa intendi per copiare in: foglio standard, modulo 1 ecc ecc. dove li trovo?
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Win 10 & Office365 Premium
danibi60
Utente Senior
 
Post: 489
Iscritto il: 11/07/13 09:21
Località: Bergamo

Re: Come copiare in automatico il contenuto di più celle

Postdi danibi60 » 21/07/13 10:06

scossa ha scritto:
danibi60 ha scritto:
Le colonne B-C-E-H saranno sempre riempite di volta in volta con testi che variano (te ne allego un esempio) e lo saranno sempre.

Non niente sfondo giallo, solo valori.


Questo il codice da copiare in un modulo standard (Modulo1):

CODICE: SELEZIONA TUTTO
'---------------------------------------------------------------------------------------
' Procedure : Ricopia
' Author : scossa
' Date : 20/07/2013
' Purpose :
'---------------------------------------------------------------------------------------
'
Public Sub Ricopia()

Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim rngFr As Range
Dim rngTo As Range
Dim cella As Range
Dim bCalc As XlCalculation

With Application
bCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
Set rng = ws.Range("A1").CurrentRegion '.Resize(, 8)
Set rngTo = ws.Range("A31")
rngTo.CurrentRegion.ClearContents
On Error Resume Next
Set rngFr = rng.Columns(1).Offset(0, 8).SpecialCells(xlCellTypeConstants, xlTextValues)
If Err.Number = 0 Then
Set rng = Intersect(rngFr.EntireRow, rng)
rng.Copy rngTo
End If
Set rng = ws.Range("L1").CurrentRegion '.Resize(, 8)
Err.Clear
Set rngFr = rng.Columns(1).Offset(0, 8).SpecialCells(xlCellTypeConstants, xlTextValues)
If Err.Number = 0 Then
Set rng = Intersect(rngFr.EntireRow, rng)
rng.Copy rngTo.Offset(rngTo.CurrentRegion.Rows.Count)
End If
'set rngto = rngto.CurrentRegion.Resize(.
On Error GoTo 0
rngTo.CurrentRegion.ClearFormats 'per eliminare il formato
With Application
.Calculation = bCalc
.ScreenUpdating = True
End With

Set rng = Nothing
Set rngFr = Nothing
Set rngTo = Nothing
Set ws = Nothing
Set wb = Nothing

End Sub



Cancella tutto il codice presente nel modulo di Foglio1 tranne:

CODICE: SELEZIONA TUTTO
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("I1:I25,T1:T25")) Is Nothing Then
Application.EnableEvents = False
Call Ricopia
Application.EnableEvents = True
End If
End Sub


Cancella tutti i codici degli altri moduli (Modulo2, Modulo3 etc.)

Ciò che mi consigli di fare Scossa, per me è arabo! non so ne dove ne come farlo!

Grazie
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Win 10 & Office365 Premium
danibi60
Utente Senior
 
Post: 489
Iscritto il: 11/07/13 09:21
Località: Bergamo

Re: Come copiare in automatico il contenuto di più celle

Postdi scossa » 21/07/13 10:36

danibi60 ha scritto:
Perdonami Scossa, ma cosa intendi per copiare in: foglio standard, modulo 1 ecc ecc. dove li trovo?


Scusa ma questo file:
http://wikisend.com/download/486408/File test danibi.xls

che hai indicato nel tuo post:
danibi60 ha scritto:Ho simulato nel file il risultato che vorrei si ottenesse dalla macro, è chiaro che il posizionamento delle varie X potrebbero variare
http://wikisend.com/download/486408/File test danibi.xls


e che contiene già il codice, chi l'ha fatto??
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 427
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: Come copiare in automatico il contenuto di più celle

Postdi danibi60 » 21/07/13 10:42

Era un codice di Anthony che avevo inserito seguendo le sue istruzioni, ma dopo averlo copiato, come ho già scritto relativamente al tuo, non solo dava errore, ma non sapevo che fare dopo averlo copiato...

capisco che tutto ciò è molto elementare e banale per Voi esperti, ma io ho la necessità - da neofita quale sono - di esser seguito passo dopo passo...altrimenti non so davvero cosa fare...

Se però, tutto questo Vi fa perdere tempo, non importa, il vostro interessamento è già di per sé davvero commovente.

Grazie scossa,
D.
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Win 10 & Office365 Premium
danibi60
Utente Senior
 
Post: 489
Iscritto il: 11/07/13 09:21
Località: Bergamo

Re: Come copiare in automatico il contenuto di più celle

Postdi danibi60 » 21/07/13 10:48

E poi aggiungo: E' necessaria e obbligatoria l'utilizzo di una macro? Non è possibile trovare la soluzione attraverso una funzione...non so...la funzione "se" ?
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Win 10 & Office365 Premium
danibi60
Utente Senior
 
Post: 489
Iscritto il: 11/07/13 09:21
Località: Bergamo

Re: Come copiare in automatico il contenuto di più celle

Postdi scossa » 21/07/13 13:20

danibi60 ha scritto:E poi aggiungo: E' necessaria e obbligatoria l'utilizzo di una macro? Non è possibile trovare la soluzione attraverso una funzione...non so...la funzione "se" ?


Non saprei, c'è qualcosa che non mi convince nella tua spiegazione ..... per copiare una volta al mese, 5 .. 10 .. 15 righe su 25, in un'altra zona del foglio, se non vuoi usare le macro, la cosa migliore è mettere un filtro automatico, filtrare le righe con il flag e copia-incollarle dove vuoi, ma forse le cose in realtà sono più complesse .....
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 427
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: Come copiare in automatico il contenuto di più celle

Postdi scossa » 21/07/13 14:14

danibi60 ha scritto:E poi aggiungo: E' necessaria e obbligatoria l'utilizzo di una macro? Non è possibile trovare la soluzione attraverso una funzione...non so...la funzione "se" ?


Con le formule sarebbe semplice se avessi i dati solo in A..I, perché devi prevedere tante righe quante sono quelle che possono essere flaggate:
per A2..I25 devi prevedere di occupare con le formule da A31 a I54:

In A31 scrivi::

Codice: Seleziona tutto
=SE.ERRORE(INDICE($A$1:$I$25;PICCOLO(RIF.RIGA($I$1:$I$25)*($I$1:$I$25="X");CONTA.SE($I$1:$I$25;"")+RIF.RIGA(A1));RIF.COLONNA((A1)));"")

matriciale da confermare con Ctrl+Maiusc+Invio.

Copia e in colla in B31:I35
Poi seleziona A31:I35 copia e incolla in A32:A54

Per i dati in L..T devi adattare le formule, da incollare in A55.... ma ti restano le eventuali righe vuote tra le righe delle due tabelle.
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 427
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: Come copiare in automatico il contenuto di più celle

Postdi danibi60 » 21/07/13 20:03

Grazie a Scossa sono riuscito a risolvere il mio problema: GRAZIE a lui e a tutti Voi.


Alla prossima,
Dani
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Win 10 & Office365 Premium
danibi60
Utente Senior
 
Post: 489
Iscritto il: 11/07/13 09:21
Località: Bergamo

Re: Come copiare in automatico il contenuto di più celle

Postdi Anthony47 » 22/07/13 12:09

Per i posteri, la riga che andava in errore era stata scritta
myCols = If Target.Column = 9 Then myCols = "A:I" Else myCols = "L:S"
e non, come suggerito (viewtopic.php?f=26&t=99632#p574309)
If Target.Column = 9 Then myCols = "A:I" Else myCols = "L:S"
Per quanto riguarda la "dichiarazione" di CheckA, e' corretta l' osservazione di danibi (CheckA = "I1:I25, T1:T25").

Ciao a tutti.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Come copiare in automatico il contenuto di più celle":


Chi c’è in linea

Visitano il forum: Nessuno e 60 ospiti