Macro copia

Hai un problema con Excel?

Nuova discussione

Macro copia
di biss73 data: 16/12/2014 16:26:50
Salve a tutti,
sono un nuovo iscritto che da poco si sta esercitando a svolgere macro per semplificarmi il lavoro.
Premetto subito che non sono molto afferrato sull'argomento (e la cosa mi dispiace molto),
ho "scopiazziato" qui sul forum per arrivare a scrivere una macro che mi fa alcune cose (nascondere e visualizzare colonne).
Ora sono arrivato al punto di chiedere aiuto ai veri professionisti, visto che non riesco ad andare avanti.
Vi spiego brevemente:
Ho un foglio di lavoro (foglio1) nel quale ci sono un numero non fisso di colonne e righe,
le prime 4 righe sono riservate a titoli ecc..
la riga 5 e quella prototipo.
con una macro nascondo le colonne che a cui non devo cambiare i dati.
Es col B,D,E
sulle restanti inserisco i dati per un numero non precisato di righe ma che terminano tutte sulla stessa riga es. 890
Da qui in poi chiedo:
un pulsante che mi riempia le celle delle colonne nascoste con il valore che è nella cella 5 della stessa colonna.
Es. col B cella 5 contiene Pippo
Col D cella 5 contiene poppo
una volta schiacciato il pulsante la stringa Pippo si deve copiare fino alla cella 890 della col. B
poppo fino alla cella 890 della col. D
ecc. Ecc.
Una volta riempite tutte le celle delle colonne attive devo raggruppare il testo di ogni riga per avere una stringa senza spazzi.
Se qualcuno può aiutarmi a farlo ne sarei felicissimo visto che sono giorni che provo a farlo senza risultati
ringrazio anticipatamente chiunque si interessi al mio caso
grazie
saluti
di lepat (utente non iscritto) data: 16/12/2014 17:58:55
allega un file di esempio con i dati e la macro che hai fatto
di biss73 (utente non iscritto) data: 16/12/2014 19:00:09
Ciao e grazieper l'interesse per il mio problema spero ti possa essere utile il file
in attesa di un riscontro ringrazio anticipatamente..
Saluti
di lepat (utente non iscritto) data: 17/12/2014 08:11:29
da quello che ho capito si tratta di copiare per ogni colonna nascosta la prima cella su tutta la colonna
è corretto ? mi sembra abbastanza banale rispetto a tutto il resto che hai fatto
di biss73 (utente non iscritto) data: 17/12/2014 09:07:08
Ciao, esatto proprio cosi devo copiare la stringa della cella 4 col. B e incollarla fino all'ultima cella attiva del foglio.
un qualcosa del tipo: se la cella B5 è vuota copia la stringa della cella B4 e incolla fino all'ultima cella attiva del foglio di lavoro, ripetere l'azione x tutte le colonne in cui sulla riga 4 c'è un valore.
questo è il risultato che dovrei ottenere, ma non riesco a farlo...
( non sono molto esperto in VBA)
se puoi darmi una dritta..
grazie

di costopoco (utente non iscritto) data: 17/12/2014 11:32:41
@ biss73
Il codice che propongo copia i campi "A÷C" e il campo "E" nelle celle sottostanti; partendo dalla prima cella vuota fino all'ultimo record valido

Fai sapere se le celle interessate alla funzione copia contengono formule o formattazioni particolari che non desideri riproporre.

Private Sub CommandButton5_Click()
Dim PRec As Long, URec As Long
    URec = Range("D" & Rows.Count).End(xlUp).Row
    PRec = Range("A" & Rows.Count).End(xlUp).Row
        Range(Cells(PRec, 1), Cells(PRec, 3)).Copy Range(Cells(PRec + 1, 1), Cells(URec, 3))
        Cells(PRec, 5).Copy Range(Cells(PRec + 1, 5), Cells(URec, 5))
End Sub

di BISS73 (utente non iscritto) data: 17/12/2014 14:09:41
Ciao, grazie 1000, per il codice proposto si avvicina molto al risultato che vorrei ottenere, ho apportato una piccola modifica e funziona grazie.
ti chiedo:
se invece di avere un renge ( specifico) URec= "O" ecc. ecc.. che punta a una colonna specifica,
come posso modificarlo con il range tipo UC ???? che a seconda delle colonne che utilizzo trova l'ultima cella piena (in qualsiasi colonna fosse) e da li ricava la cella in cui si deve
fermare a copiare le stringhe di ogni colonna?
PS. le celle non contengono nessuna formula o altro solo testi o numeri
grazie
Saluti

Sub CommandButton5_Click()

 UR = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Row ' ULTIMA RIGA PIENA
 UC = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Column ' ULTIMA COLONNA PIENA


Dim PRec As Long, URec As Long
    URec = Range("O" & Rows.Count).End(xlUp).Row
    PRec = Range("A" & Rows.Count).End(xlUp).Row
        Range(Cells(PRec, 1), Cells(PRec, UC)).Copy Range(Cells(PRec + 1, 1), Cells(URec, UC))
        Cells(PRec, 5).Copy Range(Cells(PRec + 1, 5), Cells(URec, 5))
End Sub

di costopoco (utente non iscritto) data: 17/12/2014 17:55:26
Prova con:
URec = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
di biss73 (utente non iscritto) data: 18/12/2014 12:42:12
ciao,
grazie ancora, ma con la soluzione che mi hai suggerito non va anzi crea scompigli...
altre soluzioni??
grazie
saluti:
di costopoco (utente non iscritto) data: 18/12/2014 14:06:13
Partendo dalla richiesta:
"se invece di avere un renge ( specifico) URec= "O" ecc. ecc.. che punta a una colonna specifica,
come posso modificarlo con il range tipo UC ???? che a seconda delle colonne che utilizzo trova l'ultima cella piena (in qualsiasi colonna fosse) e da li ricava la cella in cui si deve
fermare a copiare le stringhe di ogni colonna?"

Nel File allegato se in userform premi il pulsante Aggiorna dopo aver posizionato il cursore in colonna:
- F verranno compilate le righe 4 ÷ 5
- G verranno compilate le righe 4 ÷ 7
- H verranno compilate le righe 4 ÷ 9
ecc.
- M verranno compilate le righe 4 ÷ 21
- N verranno compilate le righe 4 ÷ 9
- O verranno compilate le righe 4 ÷ 5

di biss73 (utente non iscritto) data: 18/12/2014 16:52:11
Ciao, grazie per la pazienza che dimostri,
ho provato il file che hai postato ( sembra non funzionare come hai commentato).
facendo un passo indietro riferito al codice che ho ora postato ti chiedo:
se per ogni dato che aggiungo ( in qualsiasi colonna in un range di colonne tipo A,P ) mi riempie una cella in una colonna ( tipo Z ) per usarla come riferimento al range (URec = Range("Z" & Rows.Count).End(xlUp).Row)
tipo se in colonna G, o A, o B, o altre comprese nel range, a partire dalla 4 fino alla cella 980 ho un testo la cella rispettiva in colonna Z si riempie di un valore qualsiasi, una volta aggiornato con il pulsante "aggiorna"
cancello i dati della colonna Z??
potrebbe essere una soluzione ( anche se non e quella più bella)
potresti darmi una dritta??
grazie
Saluti

Sub CommandButton5_Click()

 UR = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Row ' ULTIMA RIGA PIENA
 UC = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Column ' ULTIMA COLONNA PIENA


Dim PRec As Long, URec As Long
    URec = Range("O" & Rows.Count).End(xlUp).Row
    PRec = Range("A" & Rows.Count).End(xlUp).Row
        Range(Cells(PRec, 1), Cells(PRec, UC)).Copy Range(Cells(PRec + 1, 1), Cells(URec, UC))
        Cells(PRec, 5).Copy Range(Cells(PRec + 1, 5), Cells(URec, 5))
End Sub

di costopoco (utente non iscritto) data: 18/12/2014 17:07:23
Che versione di excel utilizzi?
Il file che ho allegato, anche se ha estensione .xls, è stato sviluppato con Excel 2013.
Prima di cercare soluzioni alternative, lasciami testare il file con una versione precedente.
di Biss73 (utente non iscritto) data: 18/12/2014 19:30:10
Ciao, scusa il ritardo ( ero alla recita dei figli)
Uso Excel 2007 comunque
Saluti ancora
di costopoco (utente non iscritto) data: 18/12/2014 20:03:50
Ok, domani, in mattinata, provo a testare il File con Excel 2000.
Non conosco Excel 2007, credo di ricordare che accetta file xlsm; se è così posso provare ad allegare lo stesso file ma con estensione .xlsm

Nel caso in cui non riusciamo a risolvere, non ci resta che una chiaccherata in Skype; con la condivisione dello schermo, magari con la partecipazione di lepat, sembra che gradisca essere coinvolto, sono abbastanza certo che possiamo risolvere rapidamente.
di Biss73 (utente non iscritto) data: 18/12/2014 23:43:30
Ok
In attesa del tuo riscontro
Grazie
Saluti
di costopoco (utente non iscritto) data: 19/12/2014 10:10:12
Non so che dirti, anche in Excel 2000 mi sembra funzioni tutto.
Molto probabilmente non sono riuscito ad interpretare correttamente la tua richiesta.
Provo ad allegare un file .xlsm
In userform ho aggiunto il tasto Cancella; mi è servito solo per velocizzare i test.
Premendo questo tasto, rimane solo il record in riga 4
Posizionando il cursore su una colonna F ÷ O e premendo Aggiorna presente in userform vengono compilati i record da riga 5 all'ultima riga della colonna selezionata.

Fammi sapere come vuoi procedere.
di biss73 (utente non iscritto) data: 19/12/2014 10:50:37
Ciao e grazie ancora della tua pazienza,
ti allego un file con un foglio dove ti spiego
grazie
Saluti
di costopoco (utente non iscritto) data: 19/12/2014 12:52:43
Partendo dal tuo file ho utilizzato questa macro che conta l'ultima cella, a prescindere dalle celle vuote e dalle colonne interessate.
Qui il mistero si infittisce.
Eseguendo il codice la risposta sarà 24, ma la riga 24 non contiene alcun valore
Ora, prova ed eliminare le righe dalla riga 5 alla 24
Esegui nuovamente il codice la risposta sarà 4
Aggiungi un valore in una delle celle sottostanti alla riga 4; il risultato indicherà la riga nella quale hai aggiunto il nuovo valore.
Cosa sia successo nelle righe dalla 5 alla 24 non mi è dato sapere, ma tant'è.

Fai alcuni test anche tu.
Option Explicit Sub Conta_Record() MsgBox ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Row End Sub
di biss73 (utente non iscritto) data: 19/12/2014 17:18:10
ciao, ho fatto qualche prova e a me il msgbox dice le righe totali interessate ( quelle effettivamente piene di qualche dato) non so più dove andare a parare per ottenere cio che vorrei ,
se hai qualche altra idea sono disponibilissimo
saluti
di costopoco (utente non iscritto) data: 19/12/2014 17:45:43
Voglaimo rischiare con Skype?
Se lo ritieni opportuno. inviami il tuo nick di Skype.

di BISS73 (utente non iscritto) data: 20/12/2014 15:21:54
ciao, ho trovato una soluzione (credo) non è molto lineare come è stata fatta ma raggiunge lo scopo che voglio ottenere sapresti snellirla un po??
Anche cosi mi andrebbe bene perooo
grazie Saluti

Sub luca_Click()
Dim UltimaRiga As Integer

 UR = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Row ' ULTIMA RIGA PIENA
 UC = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Column ' ULTIMA COLONNA PIENA

 UltimaRiga = ActiveSheet.Cells.Find(What:="", _
 SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row - 1
 
 Range("A4").Select
If Range("A5") = 0 Then
 Selection.Copy
 Range("A5:A" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("B4").Select
If Range("B5") = 0 Then
 Selection.Copy
 Range("B5:B" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("C4").Select
If Range("C5") = 0 Then
 Selection.Copy
 Range("C5:C" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("D4").Select
If Range("D5") = 0 Then
 Selection.Copy
 Range("D5:D" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("E4").Select
If Range("E5") = 0 Then
 Selection.Copy
 Range("E5:E" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("F4").Select
If Range("F5") = 0 Then
 Selection.Copy
 Range("F5:F" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("G4").Select
If Range("G5") = 0 Then
 Selection.Copy
 Range("G5:G" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("H4").Select
If Range("H5") = 0 Then
 Selection.Copy
 Range("H5:H" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("I4").Select
If Range("I5") = 0 Then
 Selection.Copy
 Range("I5:I" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("J4").Select
If Range("J5") = 0 Then
 Selection.Copy
 Range("J5:J" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("K4").Select
If Range("K5") = 0 Then
 Selection.Copy
 Range("K5:K" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("L4").Select
If Range("L5") = 0 Then
 Selection.Copy
 Range("L5:L" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("M4").Select
If Range("M5") = 0 Then
 Selection.Copy
 Range("M5:M" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("N4").Select
If Range("N5") = 0 Then
 Selection.Copy
 Range("N5:N" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("M4").Select
If Range("M5") = 0 Then
 Selection.Copy
 Range("M5:M" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("N4").Select
If Range("N5") = 0 Then
 Selection.Copy
 Range("N5:N" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

Range("O4").Select
If Range("O5") = 0 Then
 Selection.Copy
 Range("O5:O" & UR).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
End If

End Sub

di costopoco (utente non iscritto) data: 20/12/2014 16:55:12
Molto probabilmente, anzi sicuramente, è un problema mio ma non riesco ancora a capire quale sia il risultato che vuoi ottenere.
If Range("A5") = 0
se "A5" =0 prende il valore di "A5" e con
Selection.Copy
Range("A5:A" & UR).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
:=False, Transpose:=False
lo copia fino all'ultimo Record valido ma "A5" è vuoto per definizione (If Range("A5") = 0) quindi copia il nulla.

Forse è la cella "A4" da copiare.

Il codice che ti propongo funziona allo stesso modo.

Testato sul tuo ultimo file le variabili "UR" e "UltimaRiga" rendono sempre ... 24; questo sarà un problema di Excel 2013 ma tant'è.

Fammi sapere se hai problemi.

Option Explicit
Sub luca()
Application.ScreenUpdating = False
Dim UR As Long, UC As Long, UltimaRiga As Long
Dim x As Byte

 UR = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Row ' ULTIMA RIGA PIENA
 UC = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Column ' ULTIMA COLONNA PIENA
 UltimaRiga = ActiveSheet.Cells.Find(What:="", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row - 1
    For x = 1 To UC
        If Cells(5, x) = 0 Then
           Cells(5, x).Copy
           Range(Cells(5, x), Cells(UR, x)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next x
 Application.CutCopyMode = False
End Sub

di biss73 (utente non iscritto) data: 21/12/2014 14:15:14
Ciaooo,
grazieeeeee 100000000000000000000000000000000000000000000000
praticamente perfetto, quello che volevo ottenere
lunica cosa che ho cambiato è:
If Cells(5, x) >= 1 Then
altrimenti non funzionava
grazie ancora per il tuo aiuto e la pazienza che hai dimostrato nei miei confronti
spero in futuro di poterti disturbare il meno possibile,
grazie grazie ancora,
ti auguro buone feste nel caso non ci sentiamo prima
grazie
Saluti
di biss73 (utente non iscritto) data: 21/12/2014 14:16:57
Ovviamente aggiungo che il problema e risolto
di biss73 (utente non iscritto) data: 21/12/2014 19:54:12
Ciao, Rieccomi di nuovo a chiederti aiuto
stavo ultimando il mio file ( grazie soprattutto al tuo inestimabile aiuto) ho praticamente ottenuto il mio scopo,
peroooo....
mi chiedevo: e se lo rendessi un pochino più utile? del tipo:
1° scegliere il nome della cartella dove salvare il file ( magari con una imputbox) sempre all'interno della directori
2° e se avessi anche la possibilità di scegliermi l'estensione del file? magari con una ListBox4??
ti allego il file dove ho gia impostato la ListBox4 che dovrebbe leggere i formati sulla riga 4
PS: sul foglio c'e' la parte di codice che ho aggiunto ( se non chiedo troppo ci daresti un occhio?? magari riesci a snellirla un po) funziona pero non esaurisce le 2 ulteriori idee
grazie ancora
ps.ps. sempre se non scoccio troppo visto anche il periodo
ringrazio anticipatamente
Saluti

Vuoi Approfondire?