- Articoli
Salve a tutti,
Sto incontrando qualche difficoltà perché non riesco a copiare alcune celle di un foglio su un' altro foglio..... Mi spiego:Vorrei trovare sul foglio 2 nella colonna 5 il rigo con valore uguale al foglio 1 range h1. Dopo di che copiare sul foglio 2 dopo la colonna g i dati presenti nelle celle d4 d8 d9 del foglio 1.
Praticamente un cerca valore e inserisci in orizzontale dopo la colonna g.
Grazie
Ti propongo questa mia macro, fa quello che chiedi ma è impostata per fare la copia Foglio/Foglio stesso File. Lascio a te implementare la copia Foglio/Foglio altro File. La macro la puoi mettere anche in un Modulo standard.
Option Explicit Sub Cerca_Copia() Dim ur1 As Long 'ultima riga cartella1 Dim uc1 As Long 'ultima colonna cartella1 Dim ur2 As Long 'ultima riga cartella2 Dim riga As Long 'riga in elaborazione Dim codice As Range 'codice in elaborazione Dim sh1 As Worksheet 'foglio cartella1 Dim sh2 As Worksheet 'foglio cartella2 Application.ScreenUpdating = False Set sh1 = Sheets("cartella1") Set sh2 = Sheets("cartella2") ur1 = sh1.Range("B" & Rows.Count).End(xlUp).Row ur2 = sh2.Range("E" & Rows.Count).End(xlUp).Row For riga = 3 To ur2 'inizia dalla 3' riga Set codice = sh1.Range("B2:B" & ur1).Find(What:=sh2.Cells(riga, 5), LookIn:=xlValues, LookAt:=xlWhole) If Not codice Is Nothing Then uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1 If uc1 < 4 Then uc1 = 4 'inizia dalla 4' colonna sh2.Range("A" & riga & ":C" & riga).Copy sh1.Cells(codice.Row, uc1) End If Next riga Application.CutCopyMode = False Application.ScreenUpdating = True End SubCiao, ho modificato il tuo codice e lo posto sotto.
mi va in debug su what.
come vedi ho anche inserito i valori e ti li ho commentati.
`Option Explicit Sub Cerca_Copia() Dim ur1 As Long 'ultima riga cartella1 Dim uc1 As Long 'ultima colonna cartella1 Dim ur2 As Long 'ultima riga cartella2 Dim riga As Long 'riga in elaborazione Dim codice As Range 'codice in elaborazione Dim sh1 As Worksheet 'foglio cartella1 Dim sh2 As Worksheet 'foglio cartella2 Application.ScreenUpdating = False Set sh1 = workbooks("cartel1.xls")worksheets("foglio1") Set sh2 = workbooks("cartel2.xls")worksheets("foglio2") ur1 = sh1.Range("C" & Rows.Count).End(xlUp).Row 'controlla la colonna c ur2 = sh2.Range("AD" & Rows.Count).End(xlUp).Row 'cerca su colonna AD For riga = 9 To ur2 'inizia dalla 9 riga' Set codice = sh1.Range("C10:C19" & ur1).Find(What:=sh2.Cells(riga, 5), LookIn:=xlValues, LookAt:=xlWhole) 'controlla sulla colonna c da c10 a c19 If Not codice Is Nothing Then uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1 If uc1 < 196 Then uc1 = 196 'inizia dalla 4' colonna sh2.Range("N" & riga & ":Q" & riga).Copy sh1.Cells(codice.Row, uc1) 'copia da N a Q End If Next riga Application.CutCopyMode = False Application.ScreenUpdating = True End Sub`Option Explicit Sub Cerca_Copia() Dim ur1 As Long 'ultima riga cartella1 Dim uc1 As Long 'ultima colonna cartella1 Dim ur2 As Long 'ultima riga cartella2 Dim riga As Long 'riga in elaborazione Dim codice As Range 'codice in elaborazione Dim sh1 As Worksheet 'foglio cartella1 Dim sh2 As Worksheet 'foglio cartella2 Application.ScreenUpdating = False Set sh1 = workbooks("cartel1.xls").workSheets("foglio1") Set sh2 = workbooks("cartel2.xls").workSheets("foglio2") ur1 = sh1.Range("C" & Rows.Count).End(xlUp).Row ' colonna dove controlla dati cartl1 ur2 = sh2.Range("AD" & Rows.Count).End(xlUp).Row ' colonna dove controlla dati cartl2 For riga = 9 To ur2 'inizia dalla 9' riga Set codice = sh1.Range("C10:C" & ur1).Find(What:=sh2.Cells(riga, 5), LookIn:=xlValues, LookAt:=xlWhole) If Not codice Is Nothing Then uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1 If uc1 < 196 Then uc1 = 196 'inizia dalla 196 colonna sh2.Range("A" & riga & ":C" & riga).Copy sh1.Cells(codice.Row, uc1) End If Next riga Application.CutCopyMode = False Application.ScreenUpdating = True End SubCiao Ho modificato il tuo codice.
mi va in debug su what.
ho inserito anche i commenti xchè ho modificato la ricerca ed i parametri.
Non avendo accesso ad altri dati, io sono fermo all'unico allegato in post #29771 e non ho la sfera di cristallo, ad intuito, se il Debug si ferma su quella riga di codice è molto probabile che non hai adeguato correttamente il riferimento della colonna (5) che, se ho capito bene le tue modifiche, ora è vuota.
I set sh1 e sh2 sono impostati correttamente?
Mi ripeto, la mia macro è collaudata sulla struttura del file che hai allegato al primo post ed è perfettamente funzionante. Non credo sia un problema del Forum ma io continuo a non vedere altri allegati oltre al primo.
Buongiorno,
per prima cosa ti ringrazio per l'interessamento, pubblico i due file con l'impostazione che devono avere.
Ho provato ad implementare il codice da te proposto ma non mi funziona.
Nella cartella2/foglio2 deve andare a scrivere in corrispondenza del codice trovato nelle celle gialle (prima cella utile GO, se occupata seconda cella utile sul solito rigo HB, se trova occupata terza cella utile HO, se trova occupata quarta cella libera IB) i valori della cartella1/foglio1.
Deve fare il controllo fino alla cella c19 sulla cartella1/foglio1.
Grazie
PS: spero di essere stato un pò più chiaro.
Hai un layout completamente scombinato rispetto all’primo allegato, hai moltissime colonne nascoste tanto che nell’area GO e seguito del Foglio2 stai cercando di copiare celle consecutive in celle alternate. Nella macro hai scambiato le coordinate di Copia con quelle di Incolla. Per non dire della formattazione personalizzata della colonna C del Foglio1 tale da impedire il confronto con il codice di ricercato.
Dato che per ora la ricerca è impostata solo per la prima occorrenza di un codice ho ‘aggiustato’ la parte della macro preposta al Cerca / Copia / Incolla. Per potere visualizzare un risultato dovrai, oltre a scoprire le colonne nell’area GO Foglio2, anche cambiare la formattazione della colonna C Foglio1 in ‘Generale’.
... For riga = 9 To ur2 Set codice = sh1.Range("C9:C" & ur1).Find(sh2.Cells(riga, 30), LookIn:=xlValues, lookat:=xlWhole) If Not codice Is Nothing Then uc1 = sh2.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 1 If uc1 < 197 Then uc1 = 197 sh1.Range("N" & codice.Row & ":Q" & codice.Row).Copy sh2.Cells(riga, uc1) End If Next riga ...Fatto questo, se hai intenzione di sistemare il layout del tuo progetto e dopo che hai riallegato le cartelle ‘ripulite’, possiamo parlare anche delle gestione dei codici ripetuti in colonna C altrimenti la mia disponibilità finisce con questo post.
ciao Rollis13,
ho modificato il tuo codice, capisco la tua richiesta ma il file deve essere come pubblicato proprio perchè a priori ci sono molti altri dati.
Posto il codice tuo modificato e funzionante sulla mia struttura, solo avrei la necessita che mi scrivesse il primo dato (che prende nella colonna N poi saltasse una cella e scrivesse il secondo dato che si trova nella colonna O, così da farlo risultare allineato al mio layout. per lo spostamento in toto basta che modifichi il + 9.....
uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 9 'cambio il nove con quello che mi serveGrazie
codice completo:
Sub CERCACOPIA_ok() Dim ur1 As Long 'ultima riga cartella1 Dim uc1 As Long 'ultima colonna cartella1 Dim ur2 As Long 'ultima riga cartella2 Dim riga As Long 'riga in elaborazione Dim codice As Range 'codice in elaborazione Dim sh1 As Worksheet 'foglio cartella1 Dim sh2 As Worksheet 'foglio cartella2 Application.ScreenUpdating = False Set sh1 = Workbooks("cartella2.xlsm").Worksheets("cartella2") Set sh2 = Workbooks("cartella1.xls").Worksheets("cartella1") ur1 = sh1.Range("AD" & Rows.Count).End(xlUp).Row ur2 = sh2.Range("C" & Rows.Count).End(xlUp).Row For riga = 10 To ur2 Set codice = sh1.Range("AD9:AD" & ur1).Find(what:=sh2.Cells(riga, 3), LookIn:=xlValues, LookAt:=xlWhole) If Not codice Is Nothing Then uc1 = sh1.Cells(codice.Row, Cells.Columns.Count).End(xlToLeft).Column + 9 If uc1 < 199 Then uc1 = 199 sh2.Range("N" & riga & ":Q" & riga).Copy sh1.Cells(codice.Row, uc1) End If Next riga Application.CutCopyMode = False Application.ScreenUpdating = True End SubTi basta prendere questa riga:
sh2.Range("N" & riga & ":Q" & riga).Copy sh1.Cells(codice.Row, uc1)e duplicarla 4 volte, 1 per ogni diversa colonna invece che una copia in blocco e poi aggiustare la variabile 'uc1' aggiungendo un +2 per le righe successive.
Ripubblico i due file stavolta con descrizione di quello che mi servirebbe all'interno.
Alessio
Ecco la macro adeguata con l'apporto delle modifiche che ti avevo suggerito nel mio post precedente.
Option Explicit Sub CERCACOPIA_1_2() Dim ur1 As Long 'ultima riga cartella1 Dim uc2 As Long 'ultima colonna cartella2 Dim ur2 As Long 'ultima riga cartella2 Dim riga As Long 'riga in elaborazione Dim codice As Range 'codice in elaborazione Dim sh1 As Worksheet 'foglio cartella1 Dim sh2 As Worksheet 'foglio cartella2 Application.ScreenUpdating = False Set sh2 = Workbooks("cartella2-1.xls").Worksheets("Foglio2") Set sh1 = Workbooks("cartella1-1.xls").Worksheets("Foglio1") ur2 = sh2.Range("AD" & Rows.Count).End(xlUp).Row ur1 = sh1.Range("C" & Rows.Count).End(xlUp).Row For riga = 10 To ur1 Set codice = sh2.Range("AD9:AD" & ur2).Find(What:=sh1.Cells(riga, 3), LookAt:=xlWhole, LookIn:=xlValues, SearchFormat:=False) If Not codice Is Nothing Then uc2 = sh2.Cells(codice.Row, sh2.Cells.Columns.Count).End(xlToLeft).Column Select Case uc2 Case Is < 197 uc2 = 197 Case Is < 210 uc2 = 210 Case Is < 223 uc2 = 223 Case Is < 236 uc2 = 236 End Select sh1.Range("N" & riga).Copy sh2.Cells(codice.Row, uc2) sh1.Range("O" & riga).Copy sh2.Cells(codice.Row, uc2 + 2) sh1.Range("P" & riga).Copy sh2.Cells(codice.Row, uc2 + 4) sh1.Range("Q" & riga).Copy sh2.Cells(codice.Row, uc2 + 6) End If Next riga Application.CutCopyMode = False Application.ScreenUpdating = True End SubAggiungo un link di cross-post:
https://www.forumexcel.it/forum/threads/trova-e-copia-tra-2-cartelle.45524/#post-361646
Chiedo scusa non sapevo che non si potesse.
Basta aver letto il Regolamento di ogni singolo Forum come richiesto al momento della registrazione.
Ti ringrazio rollis e chiedo scusa soprattutto a te.
Ho testato il tuo codice, ma c è qualcosa che non va..... Nel senso che uc2 conta le colonne piene e vuote? Non riesco ad impostare la giusta posizione dove copia i dati, se cambio i parametri di uc2, in alcune occasioni non copia niente anche se su c della cartella 1 (N-O-P-Q) i dati ci sono.
Grazie
La macro è testata in tutte le salse ed i valori riportati nel Select Case uc2 sono esatti per gli ultimi file allegati al post #29986; le combinazioni indicate nel Select Case uc2 corrispondono esattamente alle colonne GO, HB, HO, IB della Cartella2.
Se a volte con dati reali non copia tutto probabilmente è per la formattazione personalizzata che hai dato alla colonna C in Cartella1. Evidentemente il parametro SearchFormat:=False del Find non digerisce tutti i valori presenti; ma questo te l'avevo già detto "Per non dire della formattazione personalizzata della colonna C del Foglio1 tale da impedire il confronto con il codice di ricercato." già nel post #29904.
LoginRegistrati
Stai vedendo 18 articoli - dal 1 a 18 (di 18 totali)
Stai vedendo 18 articoli - dal 1 a 18 (di 18 totali)
