| | 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 | |
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] |
|
|