Risultati da 1 a 4 di 4

Discussione: Modificare Macro Archivia per includere dei Range diversi



  1. #1
    L'avatar di Lety88
    Clicca e Apri
    Data Registrazione
    Mar 2016
    Località
    Brindisi
    Età
    29
    Messaggi
    131
    Versione Office
    Office 2013
    Likes ricevuti
    0
    Likes dati
    7

    Modificare Macro Archivia per includere dei Range diversi

    Buongiorno,

    potreste gentilmente aiutarmi a modificare la seguente macro che posto sotto, affinche quando clicco su Archivia sul foglio Cliente, mi copia contenuto della cella O3 ed O4 del foglio Cliente, e lo va incollare nel foglio Imballaggio in questo modo:

    (scarto)
    il contenuto di O3 foglio Cliente me lo copia in A2 e G2 foglio Imballo, mentre il contenuto di O4 me lo copia in N2.

    (Imballo)

    Il contenuto delle Colonne F, M, N che posso occupare un numero indefinito di record, me li copia sempre nel foglio imballaggio a partire dalla riga 3 in questo modo:

    La colonna N del foglio Cliente deve essere copiata nella colonna A del foglio Imballo;

    La colonna M del foglio Cliente deve essere copiata nella colonna G del foglio Imballo;

    La colonna F del foglio Cliente deve essere copiata nella colonna N del foglio Imballo;


    Quando mi va a copiare le colonne indicate nel secondo punto nel foglio imballaggio, per i seguenti intervalli mi deve ripetere il dato contenuto nella riga 2.

    intervallo sono: da B a F, da H a M, da O a V foglio Imballaggio.

    tempo fa mi aiuto Rubik72, desidero se gentilmente potete indicarmi come modificare i range.

    Vi ringrazio per la corte attenzione.

    Codice: 
    Sub Archivia_Colonne()
    Dim wks1 As Worksheet, wks2 As Worksheet
    Dim uRiga1 As Long, uRiga2 As Long
    Dim Indirizzo
    Dim iRow As Integer, iCol As Integer
    
    
    Set wks1 = Worksheets("Principale")
    Set wks2 = Worksheets("Archivio")
        
    uRiga1 = 2
    Do Until Foglio1.Cells(uRiga1, 5) = ""
        uRiga1 = uRiga1 + 1
    Loop
    
    
    uRiga2 = wks2.Range("K" & Rows.Count).End(xlUp).Row
            
    Indirizzo = Array("A", "B", "C", "D", "K", "R", "AE", "AA", "AB", "AC", "AD", "AF", "AG", "AH")
    
    
    For iRow = 2 To uRiga1 - 1
        For iCol = 1 To 14
            wks2.Range(Indirizzo(iCol - 1) & uRiga2 + iRow - 1) = wks1.Cells(iRow, iCol)
        Next iCol
    Next iRow
        
    For iRow = uRiga2 + 1 To uRiga2 + uRiga1 - 2
        If iRow < 3 Then GoTo 10
        For iCol = 5 To 10
            wks2.Cells(iRow, iCol) = wks2.Cells(iRow - 1, iCol)
        Next iCol
    10:
    Next iRow
    
    
    For iRow = uRiga2 + 1 To uRiga2 + uRiga1 - 2
        If iRow < 3 Then GoTo 20
        For iCol = 12 To 17
            wks2.Cells(iRow, iCol) = wks2.Cells(iRow - 1, iCol)
        Next iCol
    20:
    Next iRow
    
    
    For iRow = uRiga2 + 1 To uRiga2 + uRiga1 - 2
        If iRow < 3 Then GoTo 30
        For iCol = 19 To 26
            wks2.Cells(iRow, iCol) = wks2.Cells(iRow - 1, iCol)
        Next iCol
    30:
    Next iRow
        
    Set wks1 = Nothing
    Set wks2 = Nothing
    Erase Indirizzo
    
    
    MsgBox "Archiviazione effettuata con successo!", vbInformation + vbOKOnly, "Archivio"
    
    
    End Sub
    File Allegati File Allegati

  2. #2
    L'avatar di Lety88
    Clicca e Apri
    Data Registrazione
    Mar 2016
    Località
    Brindisi
    Età
    29
    Messaggi
    131
    Versione Office
    Office 2013
    Likes ricevuti
    0
    Likes dati
    7

    Re: Modificare Macro Archivia per includere dei Range diversi

    Sono riuscita in parte a modificarla, ma non funziona correttamente, i dati fissi per i range B a F, da H a M, da O a V foglio Imballaggio, me li ripete, ma non copia i dati dal foglio Cliente.
    E' una macro complessa, comunque vi ringrazio per la cortese attenzione.

    Codice: 
    Sub Archivia()
    Dim wks1 As Worksheet, wks2 As Worksheet
    Dim uRiga1 As Long, uRiga2 As Long
    Dim Indirizzo
    Dim iRow As Integer, iCol As Integer
    
    
    Set wks1 = Worksheets("Cliente")
    Set wks2 = Worksheets("Imballaggio")
        
    uRiga1 = 4
    Do Until Foglio1.Cells(uRiga1, 5) = ""
        uRiga1 = uRiga1 + 1
    Loop
    
    
    uRiga2 = wks2.Range("K" & Rows.Count).End(xlUp).Row
            
    Indirizzo = Array("F", "M", "N")
    
    
    For iRow = 4 To uRiga1 - 1
        For iCol = 1 To 14
            wks2.Range(Indirizzo(iCol - 1) & uRiga2 + iRow - 1) = wks1.Cells(iRow, iCol)
        Next iCol
    Next iRow
        
    For iRow = uRiga2 + 1 To uRiga2 + uRiga1 - 2
        If iRow < 1 Then GoTo 10
        For iCol = 2 To 6
            wks2.Cells(iRow, iCol) = wks2.Cells(iRow - 1, iCol)
        Next iCol
    10:
    Next iRow
    
    
    For iRow = uRiga2 + 1 To uRiga2 + uRiga1 - 2
        If iRow < 3 Then GoTo 20
        For iCol = 8 To 13
            wks2.Cells(iRow, iCol) = wks2.Cells(iRow - 1, iCol)
        Next iCol
    20:
    Next iRow
    
    
    For iRow = uRiga2 + 1 To uRiga2 + uRiga1 - 2
        If iRow < 3 Then GoTo 30
        For iCol = 15 To 22
            wks2.Cells(iRow, iCol) = wks2.Cells(iRow - 1, iCol)
        Next iCol
    30:
    Next iRow
        
    Set wks1 = Nothing
    Set wks2 = Nothing
    Erase Indirizzo
    
    
    MsgBox "Archiviazione effettuata con successo!", vbInformation + vbOKOnly, "Archivio"
    
    
    End Sub

  3. #3

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7115
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2060
    Likes dati
    1296

    Re: Modificare Macro Archivia per includere dei Range diversi

    Ciao Lety,
    visto che quella su cui stai lavorando la ritieni una macro complessa, cerco di postartene una che spero sia più leggibile per te che possa gestirla autonomamente.
    Sperando sempre di aver capito cosa vuoi ottenere.

    Codice: 
    Option Explicit
    Sub archivia()
        Dim wks1 As Worksheet, wks2 As Worksheet
        Dim y As Long, uRiga As Long, iRiga As Long
        Set wks1 = Worksheets("Cliente")
        Set wks2 = Worksheets("Imballaggio")
        Application.ScreenUpdating = False
        With wks2
            .Range("A2") = wks1.Range("O3")
            .Range("G2") = wks1.Range("O3")
            .Range("N2") = wks1.Range("O4")
            iRiga = wks1.Range("N" & Rows.Count).End(xlUp).Row
            uRiga = .Range("A" & Rows.Count).End(xlUp).Row + 1
            wks1.Range("N4:N" & iRiga).Copy
            .Range("A" & uRiga).PasteSpecial Paste:=xlValues
            wks1.Range("M4:M" & iRiga).Copy
            .Range("G" & uRiga).PasteSpecial Paste:=xlValues
            wks1.Range("F4:F" & iRiga).Copy
            .Range("N" & uRiga).PasteSpecial Paste:=xlValues
            For y = uRiga To 10000
                If .Range("A" & y) <> "" Then
                    .Range("B2:F2").Copy
                    .Range("B" & y).PasteSpecial Paste:=xlValues
                    .Range("H2:M2").Copy
                    .Range("H" & y).PasteSpecial Paste:=xlValues
                    .Range("O2:V2").Copy
                    .Range("O" & y).PasteSpecial Paste:=xlValues
                End If
            Next
        End With
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        Set wks1 = Nothing
        Set wks2 = Nothing
    End Sub
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  4. #4
    L'avatar di Lety88
    Clicca e Apri
    Data Registrazione
    Mar 2016
    Località
    Brindisi
    Età
    29
    Messaggi
    131
    Versione Office
    Office 2013
    Likes ricevuti
    0
    Likes dati
    7

    Re: Modificare Macro Archivia per includere dei Range diversi

    Grazie ges per la disponibilità funziona correttamente.

Discussioni Simili

  1. [Risolto] Macro Archivia dati dal video excel in pillole 56
    Di francosisco nel forum Domande su Excel VBA e MACRO
    Risposte: 11
    Ultimo Messaggio: 18/10/16, 22:04
  2. Modificare composizione macro
    Di PALLAS0TTO nel forum Domande su Excel VBA e MACRO
    Risposte: 6
    Ultimo Messaggio: 07/07/16, 19:28
  3. Modificare macro Sorteggio
    Di roky48 nel forum Domande su Excel VBA e MACRO
    Risposte: 14
    Ultimo Messaggio: 02/05/16, 14:39
  4. macro per modificare contenuto altre macro.
    Di nessi nel forum Domande su Excel VBA e MACRO
    Risposte: 4
    Ultimo Messaggio: 15/04/16, 16:53
  5. Range da modificare
    Di D@nilo nel forum Domande su Excel VBA e MACRO
    Risposte: 11
    Ultimo Messaggio: 10/03/16, 12:25

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •