copia e incolla le colonne

Hai un problema con Excel?

Nuova discussione

copia e incolla le colonne
di GB data: 21/12/2015 12:26:31
Ciaoa tutti
Chiedo un aiuto per automatizzare una funzione di "Copia" e "Incolla Speciale Valori" su colonne.
Ho già creato una specie di macro con il registratore di Excel ma solo per prova in quanto le colonne possono essere a occupazione variabile mentre la macro creata con il registratore ha delle selezioni fisse.
La macro dovrebbe fare queste cose:
1) Copia dal “Foglio2” da A2 a scendere fino all’ultima cella occupata.
2) Si entra in “Foglio1” e Incolla Speciale Valori in A2 e in F2
3) Si rientra in “Foglio2” e copia da B2 a scendere fino all’ultima cella occupata
4) Si rientra in “Foglio1 e Incolla Speciale Valori in G2
5) Si rientra in “Foglio2” e copia da D2 a scendere fino all’ultima cella occupata
6) Si rientra in “Foglio1” e Incolla Speciale Valori in H2 e in Colonna A dalla prima cella libera

Il codice creato con il registratore
Sub Copia_Incolla()
'
' Copia_Incolla Macro
'

'
Range("A2:A41").Select 'Posiziona su Log totale senza IQ1SM
Selection.Copy 'Copia Log totale senza IQ1SM
Sheets("Foglio1").Select 'Si sposta su folgio 1
Range("A2").Select 'Si seleziona su A2
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Incolla Speciale Valori Log totale senza IQ1SM
Range("F2").Select 'Si seleziona su F2
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Incolla Speciale Valori Log totale senza IQ1SM
Sheets("Foglio2").Select 'Si sposta su foglio 2
Range("B2:B41").Select 'Seleziona in colonna B la zona da copiare dei Modi
Application.CutCopyMode = False
Selection.Copy 'Copia la colonna dei Modi
Sheets("Foglio1").Select 'Si sposta su folgio 1
Range("G2").Select 'Si seleziona su G2
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Incolla Speciale Valori dei Modi
Sheets("Foglio2").Select 'Si sposta su foglio 2
Range("D2:D21").Select 'Seleziona in colonna D la zona da copiare del Log di IQ1SM
Application.CutCopyMode = False
Selection.Copy 'Copia la colonna del Log di IQ1SM
Sheets("Foglio1").Select 'Si sposta su folgio 1
Range("H2").Select 'Si seleziona su H2
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Incolla Speciale Valori del Log di IQ1SM
ActiveWindow.SmallScroll Down:=27
Range("A42").Select 'Si seleziona nella prima cella libera della colonna A
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Incolla Speciale Valori del Log di IQ1SM
ActiveWindow.SmallScroll Down:=-36
Range("D17").Select
End Sub
Come vedete però ha delle selezioni di celle fisse, non so scrivere le routine per la ricerca delle celle libere o occupate, potete darmi una mano?
Grazie mille
Gianni

Sub Copia_Incolla()
'
' Copia_Incolla Macro
'

'
    Range("A2:A41").Select          		 'Posiziona su Log totale senza IQ1SM
    Selection.Copy                     		 'Copia Log totale senza IQ1SM
    Sheets("Foglio1").Select           	 'Si sposta su folgio 1
    Range("A2").Select                 		 'Si seleziona su A2
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False      	 'Incolla Speciale Valori Log totale senza IQ1SM
    Range("F2").Select                 		 'Si seleziona su F2
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False      	 'Incolla Speciale Valori Log totale senza IQ1SM
    Sheets("Foglio2").Select           	 'Si sposta su foglio 2
    Range("B2:B41").Select             	 'Seleziona in colonna B la zona da copiare dei Modi
    Application.CutCopyMode = False
    Selection.Copy                    		  'Copia la colonna dei Modi
    Sheets("Foglio1").Select          	  'Si sposta su folgio 1
    Range("G2").Select                  		 'Si seleziona su G2
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False      	 'Incolla Speciale Valori dei Modi
    Sheets("Foglio2").Select           	 'Si sposta su foglio 2
    Range("D2:D21").Select             	 'Seleziona in colonna D la zona da copiare del Log di IQ1SM
    Application.CutCopyMode = False
    Selection.Copy                     		 'Copia la colonna del Log di IQ1SM
    Sheets("Foglio1").Select           	 'Si sposta su folgio 1
    Range("H2").Select                 		 'Si seleziona su H2
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False      	 'Incolla Speciale Valori del Log di IQ1SM
    ActiveWindow.SmallScroll Down:=27
    Range("A42").Select                		 'Si seleziona nella prima cella libera della colonna A
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False      	 'Incolla Speciale Valori del Log di IQ1SM
    ActiveWindow.SmallScroll Down:=-36
    Range("D17").Select
End Sub

di Marius44 data: 21/12/2015 14:59:35
Ciao Gianni
prova ad allegare il file con le prove. Si può tentare di darti una mano.

Ciao,
Mario
di GB data: 21/12/2015 17:55:24
Ciao Mario, grazie per l'interessamento
allego un file creato come modello, nel foglio2 ho messo un tasto con la macro creata da me ma serve a poco perchè non mi fa la ricerca delle celle libere o occupate che poi è quello che interessa a me.
Grazie per l'aiuto che puoi darmi.
Saluti
Gianni

di Mister_x (utente non iscritto) data: 21/12/2015 18:44:47
ciao

sub() in alternativa alla tua

ciao

Sub Copia_Incolla()
  Dim F1 As String, F2 As String
  F1 = Sheets(1).Name
  F2 = Sheets(2).Name
Sheets(F2).Range("A2:A" & Sheets(F2).Cells(Rows.Count, "A").End(xlUp).Row).Copy
Sheets(F1).Range("A" & Sheets(F1).Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets(F1).Range("F" & Sheets(F1).Cells(Rows.Count, "F").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
''''
Sheets(F2).Range("B2:B" & Sheets(F2).Cells(Rows.Count, "B").End(xlUp).Row).Copy
Sheets(F1).Range("G" & Sheets(F1).Cells(Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
''''''
Sheets(F2).Range("D2:D" & Sheets(F2).Cells(Rows.Count, "D").End(xlUp).Row).Copy
Sheets(F1).Range("H" & Sheets(F1).Cells(Rows.Count, "H").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

di Marius44 data: 21/12/2015 18:59:25
Prova con la macro qui sotto da associare al pulsante

Fai sapere. Ciao,
Mario

PS Stasera sono destinato agli accavallamenti. Scusa e ciao Mister_X

Sub Copia_Incolla_Due()
Dim uRg As Long
    Application.ScreenUpdating = False
    uRg = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Foglio2").Range("A2:A" & uRg).Copy
    Sheets("Foglio1").Range("A2").PasteSpecial Paste:=xlValues
    Sheets("Foglio1").Range("F2").PasteSpecial Paste:=xlValues
    uRg = Sheets("Foglio2").Cells(Rows.Count, 2).End(xlUp).Row
    Sheets("Foglio2").Range("B2:B" & uRg).Copy
    Sheets("Foglio1").Range("G2").PasteSpecial Paste:=xlValues
    uRg = Sheets("Foglio2").Cells(Rows.Count, 4).End(xlUp).Row
    Sheets("Foglio2").Range("A2:A" & uRg).Copy
    Sheets("Foglio1").Range("H2").PasteSpecial Paste:=xlValues
    uRg = Sheets("Foglio1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Sheets("Foglio1").Range("A" & uRg).PasteSpecial Paste:=xlValues
    Application.ScreenUpdating = True
    Sheets("Foglio1").Select
End Sub

di Mister_x (utente non iscritto) data: 22/12/2015 00:56:15
ciao Mario

rientrato adesso e visto il tuo intervento , e ho notato che nella mia manca un ultimo Paste

modificata in fretta e pulita nei particolari la ripropongo interamente

ciao anche a GB

Sub Copia_Incolla()
  Dim F1 As String, F2 As String
  F1 = Sheets(1).Name
  F2 = Sheets(2).Name
Sheets(F2).Range("A2:A" & Sheets(F2).Cells(Rows.Count, "A").End(xlUp).Row).Copy
Sheets(F1).Range("A" & Sheets(F1).Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial _
          Paste:=xlPasteValues
Sheets(F1).Range("F" & Sheets(F1).Cells(Rows.Count, "F").End(xlUp).Row + 1).PasteSpecial _
        Paste:=xlPasteValues
''''
Sheets(F2).Range("B2:B" & Sheets(F2).Cells(Rows.Count, "B").End(xlUp).Row).Copy
Sheets(F1).Range("G" & Sheets(F1).Cells(Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial _
        Paste:=xlPasteValues
''''''
Sheets(F2).Range("D2:D" & Sheets(F2).Cells(Rows.Count, "D").End(xlUp).Row).Copy
Sheets(F1).Range("H" & Sheets(F1).Cells(Rows.Count, "H").End(xlUp).Row + 1).PasteSpecial _
        Paste:=xlPasteValues
Sheets(F1).Range("A" & Sheets(F1).Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial _
        Paste:=xlPasteValues
End Sub

di GB data: 22/12/2015 07:30:11
Grazie Mario e Mister_X, siete gentili e bravi tutti e due.
Ho provato subito la macro di Mister_X e infatti come mi dice nell'ultimo messaggio era incompleta perchè non mi copiava/incollava l'utima parte, poi ho provato la macro di Mario e ha funzionato subito perfettamente.
Questa mattina ho riprovato la macro corretta di Mister_X e questa volta ha funzionato bene, quindi ora ne ho due, ne userò una a caso visto che funzionano perfettamente tutte e due.
Vi ringrazio ancora per l'aiuto.
Cordiali saluti
Gianni

Vuoi Approfondire?