Macro excel su due fogli

Versione Completa Stampa Cerca Utenti Iscriviti Condividi :

Excel Forum » Excel Forum » » Soluzioni Excel Domande e Risposte

mdj2000

00giovedì 18 maggio 2017 15:46

Ciao ragazzi, ho un problema, su foglio 1 ho dei dati , poniamo ipotesi:
dalla colonna A alla colonna L su ogni rigo registro un prodotto CON LE VARIE DESCRIZIONI E SERIALI, nella colonna G inserisco la quantità, E se la quantità è presente mi deve spostare i dati della colonna F, H,K,L M NEL FOGLIO 2 A PARTIRE DAL RIGO 25 DELLA COLONNA A.
Più o meno il concetto è questo, mi potreste aiutare con qualche macro?
Grazie 1000
P.s. sto diventando matto [SM=x423023]

alfrimpa

00giovedì 18 maggio 2017 15:56

Mdj allega un file di esempio con i dati, spiegazione e risultato desiderato inserito a mano.

patel45

00giovedì 18 maggio 2017 15:56

allega un file di esempio con dati, spiegazioni e risultato desiderato

mdj2000

00venerdì 19 maggio 2017 07:51

aiuto macro

allego il file.
Grazie mille per la celere risposta
[SM=x423028]

patel45

00venerdì 19 maggio 2017 10:55

il risultato desiderato l'hai messo ?

mdj2000

00venerdì 19 maggio 2017 11:22

risposta

allego il file con il risultato desiderato.
GRAZIE 1000 [SM=x423017]

patel45

00venerdì 19 maggio 2017 11:45

nel modulo del foglio registro copia questa

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 7 And Target.Value = "X" Then
  LR = Sheets("DDT").Cells(Rows.Count, "A").End(xlUp).Row + 1
  Sheets("DDT").Cells(LR, 1) = Target.Offset(0, -1)
  Sheets("DDT").Cells(LR, 2) = Target.Offset(0, 3)
  Sheets("DDT").Cells(LR, 3) = Target.Offset(0, 1)
  Sheets("DDT").Cells(LR, 7) = Target.Offset(0, 4)
  Sheets("DDT").Cells(LR, 8) = Target.Offset(0, 6)
  
End If
End Sub

mdj2000

00venerdì 19 maggio 2017 12:06

re: marco

Ciao, ci sto provando, ma non riesco, non posso creare una macro con un nome nuovo ed assegnarlo ad un pulsante?
grazie per la pazienza [SM=x423017]

patel45

00venerdì 19 maggio 2017 13:03

avevo capito che la copia doveva avvenire quando inserisci la X nella colonna G, non è così ?
cosa non riesci a fare ?

mdj2000

00venerdì 19 maggio 2017 13:29

re:marco

Si, infatti è così, ma vorrei che fosse sotto il comando di un pulsante.
grazie

patel45

00venerdì 19 maggio 2017 15:27

non è possibile, come fa la macro a sapere dove hai inserito la X ? gestendo l'evento change invece è possibile

mdj2000

00venerdì 19 maggio 2017 15:34

Mi manderesti il file di esempio che ho fatto io compilato da te?
grazie
[SM=x423017]

patel45

00venerdì 19 maggio 2017 16:33

eccolo

mdj2000

00venerdì 19 maggio 2017 18:21

Intanto grazie per il file, ma come faccio a cancellare il contenuto del ddt quando tolgo le x dal foglio del registro? si può automatizzare o devo fare tutto a mano?
Grazie

patel45

00venerdì 19 maggio 2017 19:09

per questo occorre una macro collegata ad un pulsante

Sub cancella()
  LR1 = Sheets("Registro").Cells(Rows.Count, "A").End(xlUp).Row
  LR2 = Sheets("DDT").Cells(Rows.Count, "A").End(xlUp).Row + 1
  Sheets("DDT").Range("A25:G" & LR2).ClearContents
  With Sheets("Registro")
    For r = 8 To LR1
      If UCase(.Cells(r, "G")) = "X" Then
        LR2 = Sheets("DDT").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheets("DDT").Cells(LR2, 1) = .Cells(r, "G").Offset(0, -1)
        Sheets("DDT").Cells(LR2, 2) = .Cells(r, "G").Offset(0, 3)
        Sheets("DDT").Cells(LR2, 3) = .Cells(r, "G").Offset(0, 1)
        Sheets("DDT").Cells(LR2, 7) = .Cells(r, "G").Offset(0, 4)
        Sheets("DDT").Cells(LR2, 8) = .Cells(r, "G").Offset(0, 6)
      End If
    Next
  End With
End Sub

mdj2000

00venerdì 19 maggio 2017 19:47

Non sto riuscendo a capire più nulla, ti invio il foglio del ddt, perchè se applico il tuo foglio sul mio ddt, mi inizia a scrivere dal rigo 65 e non 25.
come mai?
grazie

patel45

00venerdì 19 maggio 2017 20:10

è buona regola allegare file significativi per non perdere tempo
modifica le 2 righe

LR2 = Sheets("DDT").Cells(Rows.Count, "A").End(xlUp).Row + 1

con

LR2 = Sheets("DDT").Cells(53, "A").End(xlUp).Row + 1

mdj2000

00venerdì 19 maggio 2017 20:33

Scusami ancora, forse mi sono spiegato male; il problema è che mi inizia a trascrivere sul foglio ddt dal rigo 65 e non dal rigo 25.
Grazie per la pazienza

patel45

00sabato 20 maggio 2017 07:31

avevo capito bene, hai fatto la modifica ? la devi fare in ambedue le macro. Se non riesci allega un file completo e non solo con un foglio, stai facendo di tutto per perdere tempo.
Come ho già detto i file devono essere significativi, quindi con dati inventati ma con la struttura completa

mdj2000

00sabato 20 maggio 2017 08:46

CIAO, GRAZIE PER LA PAZIENZA, ADESSO MI FUNZIONA QUASI TUTTO, NEL SENSO CHE NEL FOGLIO REGISTRO METTO LE X E LE PASSA NEL DDT, MA INIZIA A SCRIVERE DAL RIGO 65 PERCHè è L'ULTIMO RIGO CON TESTO IN QUANTO CI SONO LE CAUSALI DI TRASPORTO E ALTRI DATI, CI SAREBBE IL MODO DI IMPOSTARGLI A SCRIVERE DAL RIGO 25? O MEGLIO L'HO MODIFICATO E LO FA, MA DAL REGISTRO MI RIPORTA SOLO L'ULTIMO RIGO CON LA X; SE PER ESEMPIO METTO LA X NELLE RIGHE 8, 9, 10 E 11, NEL DDT MI RIPORTA SOLO IL RIGO 11.
COME MAI?
TI ALLEGO IL CODICE DEL FOGLIO REGISTRO:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 7 And Target.Value = "X" Then
LR = Sheets("DDT").Cells(25, "A").End(xlUp).Row + 1
LR2 = Sheets("DDT").Cells(53, "A").End(xlUp).Row + 1
Sheets("DDT").Cells(LR, 1) = Target.Offset(0, -1)
Sheets("DDT").Cells(LR, 2) = Target.Offset(0, 3)
Sheets("DDT").Cells(LR, 3) = Target.Offset(0, 1)
Sheets("DDT").Cells(LR, 7) = Target.Offset(0, 4)
Sheets("DDT").Cells(LR, 8) = Target.Offset(0, 6)

End If
End Sub

GRAZIE MILLE

patel45

00sabato 20 maggio 2017 10:19

Re:

in questa macro LR2 non viene utilizzato, quindi è inutile aggiungerlo. occorre modificare LR

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 7 And Target.Value = "X" Then
  LR = Sheets("DDT").Cells(53, "A").End(xlUp).Row + 1 ' <<<<<<
  Sheets("DDT").Cells(LR, 1) = Target.Offset(0, -1)
  Sheets("DDT").Cells(LR, 2) = Target.Offset(0, 3)
  Sheets("DDT").Cells(LR, 3) = Target.Offset(0, 1)
  Sheets("DDT").Cells(LR, 7) = Target.Offset(0, 4)
  Sheets("DDT").Cells(LR, 8) = Target.Offset(0, 6)

End If
End Sub

mdj2000

00sabato 20 maggio 2017 11:11

Grazie mille di tutto.
sei un grande !!!!!!!!!!!!!!
[SM=x423018]

Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 02:04.