matteotassi
00venerdì 9 febbraio 2018 12:48
Salve, in allegato un file excel creato qualche tempo fa.
Volevo sapere come potrei modificare la macro chiamata "Aggiorna", copiando anche i dati della colonna G (della scheda mensile), nei singoli altri fogli (unità immobiliari) alla posizione rispettiva sulla colonna A.
Grazie dell'aiuto
dodo47
00venerdì 9 febbraio 2018 13:44
Ciao
non so se ho capito, prova a sostituire:
Public Sub AggiornaFogli(aWB As Workbook, aRng As Range, i As Long)
Dim destSH As Worksheet
Dim srcRng As Range, destrng As Range
Dim rngFormulas As Range
Dim aCell As Range, rCell As Range
Dim iCtr As Long, Classe As String
For Each rCell In aRng.Cells
If rCell.Value <> vbNullString Then
Set srcRng = rCell.Offset(0, -2).Resize(1, 3)
Set destSH = aWB.Sheets(CStr(rCell.Offset(0, 2).Value))
Classe = rCell.Offset(, 3)
With destSH
.Select
iCtr = 0
Set rngFormulas = destSH.Columns("D").SpecialCells(xlCellTypeFormulas)
For Each aCell In rngFormulas.Cells
iCtr = iCtr + 1
If iCtr = i Then
Set destrng = aCell.End(xlUp)(2).Offset(0, -2).Resize(1, 3)
Exit For
End If
Next aCell
With destrng
.Value = srcRng.Value
If Cells(.Row, 2) <> "" Then Cells(.Row, 1) = Classe
.Offset(1).EntireRow.Insert CopyOrigin:=xlFormatFromLeftOrAbove
End With
End With
End If
Classe = ""
Next rCell
End Sub Saluti
matteotassi
00venerdì 9 febbraio 2018 16:48
Esatto, grazie!
Se volessi creare un automatismo per cancellare i dati inseriti sulla scheda 'Mensile' per intenderci solo quelli evidenziati nell'allegato (ho fatto solo il primo mese per capire)?
dodo47
00venerdì 9 febbraio 2018 17:58
Ciao
la struttura è molto complessa per avere riferimenti certi.
Se vanno cancellati tutti i dati che contengono una "DATA" in col. C, basta che fai un loop di tale colonna per cancellare le celle interessate.
saluti
raffaele1953
00sabato 10 febbraio 2018 01:22
Devi usare una sola riga sotto tra elimina e cancella
vb
Sub Elimina_righe()
Dim Ur As Long, X As Long, N As Long
Ur = Sheets("Mensile").Range("C" & Rows.Count).End(xlUp).Row
N = InputBox("Inserire il numero del mese da cancellare, ex gennaio = 1", , 0)
On Error Resume Next
For X = Ur To 6 Step -1
If Month(Sheets("Mensile").Cells(X, 3).Value) = N Then
'Sheets("Mensile").Range("A" & X & ":G" & X).Clear 'questo cancella
'Sheets("Mensile").Rows(X & ":" & X).Delete 'questo elimina
End If
Next X
MsgBox "Fatto"
End Sub
matteotassi
00sabato 10 febbraio 2018 17:44
Grazie della risposta Raffaele,
la macro da te proposta funziona, vorrei solo che non venga cancellata la formattazione (nella colonna A ho un elenco a discesa che mi scompare altrimenti) ma solo il contenuto delle celle e che la colonna F non venga toccata dalla macro (in quanto contiene una formula basata sui valori delle altre celle e quindi se le altre sono zero anche quella si annulla in automatico.
Grazie
raffaele1953
00sabato 10 febbraio 2018 18:00
vb
Sub Elimina_valori()
Dim Ur As Long, X As Long, N As Long
Ur = Sheets("Mensile").Range("C" & Rows.Count).End(xlUp).Row
N = InputBox("Inserire il numero del mese da cancellare, ex gennaio = 1", , 0)
On Error Resume Next
For X = Ur To 6 Step -1
If Month(Sheets("Mensile").Cells(X, 3).Value) = N Then
Sheets("Mensile").Range("A" & X & ":E" & X) = "" ' azzera i valori
Sheets("Mensile").Range("G" & X) = "" ' azzera anche colonna G ma non la F
End If
Next X
MsgBox "Fatto"
End Sub
matteotassi
00venerdì 16 febbraio 2018 11:35
Ciao,
in risposta a quanto mi avevi proposto:
Ciao
non so se ho capito, prova a sostituire:
Public Sub AggiornaFogli(aWB As Workbook, aRng As Range, i As Long)
Dim destSH As Worksheet
Dim srcRng As Range, destrng As Range
Dim rngFormulas As Range
Dim aCell As Range, rCell As Range
Dim iCtr As Long, Classe As String
For Each rCell In aRng.Cells
If rCell.Value <> vbNullString Then
Set srcRng = rCell.Offset(0, -2).Resize(1, 3)
Set destSH = aWB.Sheets(CStr(rCell.Offset(0, 2).Value))
Classe = rCell.Offset(, 3)
With destSH
.Select
iCtr = 0
Set rngFormulas = destSH.Columns("D").SpecialCells(xlCellTypeFormulas)
For Each aCell In rngFormulas.Cells
iCtr = iCtr + 1
If iCtr = i Then
Set destrng = aCell.End(xlUp)(2).Offset(0, -2).Resize(1, 3)
Exit For
End If
Next aCell
With destrng
.Value = srcRng.Value
If Cells(.Row, 2) <> "" Then Cells(.Row, 1) = Classe
.Offset(1).EntireRow.Insert CopyOrigin:=xlFormatFromLeftOrAbove
End With
End With
End If
Classe = ""
Next rCell
End Sub
Saluti
Volevo chiederti come modificare ulteriormente il codice qualora volessi copiare anche altre 4 colonne a destra della colonna G della scheda mensile, posizionate nelle prime 4 colonne libere sui vari fogli di destinazione.
Grazie dell'aiuto