Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Copiare celle a se trovo corrispondenza

Ultimo Aggiornamento: 02/11/2020 19:11
Post: 4
Registrato il: 22/09/2020
Età: 43
Utente Junior
2013
OFFLINE
30/10/2020 12:52

Buongiorno e grazie in anticipo....
Avrei bisogno di una mano per fare un file excel...Vi spiego.
Nel file LABORATORIO, aggiorno manualmente la colonna F (matricola), avrei bisogno che ogni volta che aggiungo una nuova matricola vengano aggiunte tutte le altre celle se IL VALORE DELLA MATRICOLA DEL FILE LABORATORIO trovi corrispondenza nel file CONTRADDITTORIO ovviamente ricopiando sia il valore delle celle che il colore....
Grazie
30/10/2020 14:20

Suggerimento, riallega i due files con Zip/Rar, perchè il forum (cambia i nomi) e non ci fà capire i nomi dei files. Inoltre informa in quale file scrivi e dove dovrebbe andare... Penso solo tramite VBE/VBA oppure (stai chiedendo solo tra Fogli invece di file)
[Modificato da ABCDEF@Excel 30/10/2020 14:23]
Post: 4
Registrato il: 22/09/2020
Età: 43
Utente Junior
2013
OFFLINE
02/11/2020 16:21

file corretto
ho zippato i file come da te richiesto
02/11/2020 19:11

Bravo hai "Zippato", dato che non dai ulteriori informazioni (tra Fogli invece di file)...
EDIT
Paste:=xlPasteAll molto lenta causa FC in C ed errore formula in F = RIF# sul mio PC
Ho preferito incollare valori e formati. In laboratorio ...
Sub Auto_Open()
Dim Ur1, Ur2, X, rg, Spath As String
Dim wk1 As Workbook: Set wk1 = ThisWorkbook
Dim sh1 As Worksheet: Set sh1 = wk1.Worksheets("Foglio1") ' da cambiare casomai
Spath = ThisWorkbook.Path
Ur1 = sh1.Range("F" & Rows.Count).End(xlUp).Row
    For Each Book In Workbooks
        If Book.Name = "Contraddittorio.xlsx" Then
            Workbooks("Contraddittorio.xlsx").Activate
        End If
    Next Book
    If ActiveWorkbook.Name <> "Contraddittorio.xlsx" Then Workbooks.Open Filename:=Spath & "\Contraddittorio.xlsx"
        Dim wk2 As Workbook: Set wk2 = ActiveWorkbook
        Dim sh2 As Worksheet: Set sh2 = wk2.Worksheets("Foglio1") ' da cambiare casomai
        Ur2 = sh2.Range("F" & Rows.Count).End(xlUp).Row
        wk1.Activate
        For X = 2 To Ur1
            If Application.WorksheetFunction.CountIf(sh2.Range("F1:F" & Ur2), sh1.Cells(X, 6)) > 0 Then
                rg = Application.WorksheetFunction.Match(sh1.Cells(X, 6), sh2.Range("F1:F" & Ur2), 0)
                sh2.Range(sh2.Cells(rg, 1), sh2.Cells(rg, 12)).Copy
                sh1.Cells(X, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                sh1.Cells(X, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                'molto lenta causa FC in C ed errore formula in celle F = RIF# sul mio PC
                'sh1.Cells(X, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= False, Transpose:=False
            End If
        Next
Set sh1 = Nothing
Set sh2 = Nothing
Set wk1 = Nothing
Set wk2 = Nothing
End Sub
[Modificato da ABCDEF@Excel 04/11/2020 13:39]
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Copiare celle "visibili" (10 messaggi, agg.: 08/04/2019 20:14)
copiare celle (2 messaggi, agg.: 27/10/2020 15:58)
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 22:26. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com