Condividi:        

[Excel] Macro per compilare un file excel

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

[Excel] Macro per compilare un file excel

Postdi *sara* » 12/03/14 21:52

Ciao a tutti!
Ho un file excel "Riassunto" nel quale nel "Foglio 3" sono inseriti alcuni dati sottoforma di tabella.
Vorrei creare una macro che partendo da questo file
apra un altro file excel "File di base"
e al foglio "Foglio 1"
inserisca in determinate celle
determinati valori della prima riga del file "Riassunto"
Vorrei che tale procedura si ripeta per un numero preciso di righe del foglio "Riassunto"
e che ogni volta il file excel compilato (copia del file "File di base") venga salvato
con un preciso nome
dato da una delle celle.

Spero di essermi spiegata abbastanza.

Ringrazio chiunque voglia aiutarmi!
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Sponsor
 

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 13/03/14 01:03

Apri il tuo "File di base", seleziona un foglio diverso da Foglio1, salvalo e chiudilo.
Poi, partendo da Foglio2 di Riassunto avvia il registratore di macro ed esegui manualmente tutte le operazioni che vorreste la macro faccia per te; quando hai finito interrompi la registrazione della macro e pubblica il codice prodotto e lo modificheremo perche' il salvataggio sia fatto con un nome prelevato dalla cella; pero' devi chiarire in quale celle il nome va prelevato.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 13/03/14 14:40

Ho fatto come mi hai detto. Questo è il risultato:
Codice: Seleziona tutto
Sub Prova()
'
' Prova Macro
'

'
    Range("B2").Select
    Selection.Copy
    Sheets("scheda").Select
    Range("C6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    Range("G23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    Range("G25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("F2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    Range("G19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("G2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    Range("G21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("I2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    Range("G31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("J2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    ActiveWindow.SmallScroll Down:=5
    Range("G41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("K2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    ActiveWindow.SmallScroll Down:=6
    Range("G45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Range("L2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("scheda").Select
    Range("G47").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Genera bp").Select
    Application.CutCopyMode = False
End Sub



Come faccio ora a dirgli che il foglio "scheda" dove deve incollare i valori appartiene ad un altro file?
E a ripetere tali comandi per un numero preciso di righe del foglio " Genera bp"? (forse questo lo so fare...)
E poi a salvare di volta in volta i file excel ottenuti?
Chiedo troppo? :oops:
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 13/03/14 15:52

Evidentemente dovevo essere piu' chiaro... Quando, partendo da Riassunto-Foglio2, avvii la registrazione macro:devi diligentemene:
a) selezionare Foglio3
b) aprire il secondo file
c) selezionae Foglio1
d) tornare su Riassunto
e) selezionare e copiare quei "determinati valori della prima riga"
f) andare su file2, selezionare le "determinate celle" e incollarvi i valori
g) salvare file2 con quel "preciso nome" derivato dal contenuto di "una delle celle"
h) ripetere d, e, f, g per un altro ciclo

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 13/03/14 16:29

Avevo capito male!
Ecco cosa ho ottenuto ora:
Codice: Seleziona tutto
Sub Prova()
'
' Prova Macro
'

'
    Sheets("scheda").Select
    Windows("Riassunto.xlsm").Activate
    Range("B2").Select
    Selection.Copy
    Windows("File di base.xls").Activate
    ActiveWindow.SmallScroll Down:=-13
    Range("C6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    Range("G23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    Range("G25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("F2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    Range("G19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("G2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    Range("G21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("I2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    ActiveWindow.SmallScroll Down:=3
    Range("G31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("J2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    ActiveWindow.SmallScroll Down:=8
    Range("G41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("K2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    ActiveWindow.SmallScroll Down:=6
    Range("G45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("L2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("File di base.xls").Activate
    Range("G47").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-20
    Range("C6").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Samuel"
    ChDir "C:\Users\Sara.PC-Sonia\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Sara.PC-Sonia\Desktop\Samuel.xls", FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    Windows("Riassunto.xlsm").Activate
    Range("B3").Select
    Selection.Copy
    Windows("Samuel.xls").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("D3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    Range("G23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    Range("G25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("F3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    Range("G19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("G3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    Range("G21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("I3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    ActiveWindow.SmallScroll Down:=8
    Range("G31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("J3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    ActiveWindow.SmallScroll Down:=3
    Range("G41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("K3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    Range("G45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("L3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Samuel.xls").Activate
    Range("G47").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-12
    Range("C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Katia"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Sara.PC-Sonia\Desktop\Katia.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    Windows("Riassunto.xlsm").Activate
    Range("B4").Select
    Selection.Copy
    Windows("Katia.xls").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("D4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    Range("G23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("E4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    Range("G25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("F4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    Range("G19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("G4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    Range("G21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("I4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    ActiveWindow.SmallScroll Down:=9
    Range("G31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("J4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    ActiveWindow.SmallScroll Down:=5
    Range("G41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("K4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    Range("G45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("L4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Katia.xls").Activate
    Range("G47").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-17
    Range("C6").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Andrea"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Sara.PC-Sonia\Desktop\Andrea.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
End Sub
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 13/03/14 16:38

Manca questa istruzione iniziale:
Workbooks.Open Filename:="C:\Users\Sara.PC-Sonia\Desktop\File di base.xls"
Sheets("scheda").Select
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 13/03/14 17:01

Ho provato a sistemarla da sola:
Codice: Seleziona tutto
Sub Prova()

On Error GoTo RigaErrore

    Dim objExcel As Object 'va bene?
    Dim objXls As Object   'va bene?
    Dim Percorso As String
    Dim NomeFile As String
    Dim Cartella As String
    Dim sh As Worksheet
    Dim RigaUltimoPrev As Integer
    Dim NumRiga As Long

    'individua foglio excel da cui prendere dati
    Set sh = ThisWorkbook.Worksheets("Foglio3")
   
    'individua file excel dove inserire i dati
    Percorso = [O6].Text
    NomeFile = "File di base.xls"
   
    With sh
       
        'individua dove fermare il ciclo
        RigaUltimoPrev = [B16].Value + 1
       
        For NumRiga = 2 To RigaUltimoPrev
       
            'crea nuova cartella con numero e nome
            Cartella = Range("E" & NumRiga).Value & " " & Range("B" & NumRiga).Text
            MkDir (Percorso & Cartella)
           
            If Dir(Percorso) <> "" Then
                'apre file excel di base
                Workbooks.Open Filename:=Percorso & NomeFile
                Sheets("scheda").Select
                'inserisce i valori di excel nel file di base
                Sheets("scheda").Select
                Windows("Riassunto.xlsm").Activate
                Range("B" & NumRiga).Select 'nome
                Selection.Copy
                Windows("File di base.xls").Activate
                Range("C6").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                 Windows("Riassunto.xlsm").Activate
                Range("D" & NumRiga).Select 'pot
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                Range("G23").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Windows("Riassunto.xlsm").Activate
                Range("E" & NumRiga).Select 'prod
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                Range("G25").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Windows("Riassunto.xlsm").Activate
                Range("F" & NumRiga).Select 'cons
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                Range("G19").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Windows("Riassunto.xlsm").Activate
                Range("G" & NumRiga).Select 'autocons
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                Range("G21").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Windows("Riassunto.xlsm").Activate
                Range("I" & NumRiga).Select  'cos
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                ActiveWindow.SmallScroll Down:=3
                Range("G31").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Windows("Riassunto.xlsm").Activate
                Range("J" & NumRiga).Select 'en
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                ActiveWindow.SmallScroll Down:=8
                Range("G41").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Windows("Riassunto.xlsm").Activate
                Range("K" & NumRiga).Select 'det
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                ActiveWindow.SmallScroll Down:=6
                Range("G45").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Windows("Riassunto.xlsm").Activate
                Range("L" & NumRiga).Select 'ssp
                Application.CutCopyMode = False
                Selection.Copy
                Windows("File di base.xls").Activate
                Range("G47").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                ActiveWindow.SmallScroll Down:=-20
                Range("C6").Select
                Application.CutCopyMode = False
                ActiveCell.FormulaR1C1 = [C6].Text
                ChDir Percorso
                ActiveWorkbook.SaveAs Filename:=Percorso & Cartella & "\" & .Range("C6").Value, _
                FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
                , CreateBackup:=False
                ActiveWindow.Close
             
         'converte il file in pdf
         'posso copiare dall'altra macro?????
         
                objXls.Close
                Set objXls = Nothing
            End If
        Next
    End With
   
RigaChiusura:
    If Not objWord Is Nothing Then
    '   objExcel.Quit     NO!
        Set objExcel = Nothing
    End If
        Set ExcelApp = Nothing
     
'messaggio finale
MsgBox "FILES GENERATI!"
Exit Sub
       
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura
End Sub


ma mi da una serie di errori e poi si blocca tutto! :cry:
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 13/03/14 18:54

Ignorando il pur lodevole tentativo "fai da te" direi che siamo vicini... Adesso pero' devi ancora "chiarire in quale celle il nome va prelevato" (le celle con cui si crea il nome file); es da cella E123 in giu' fintanto che si trova una cella vuota (esempio)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 14/03/14 09:46

Allora:
il ciclo va ripetuto per il numero di volte scritto nella cella B16
e mano a mano che salvo i file, questi devono avere come nome il testo scritto nelle celle della colonna B
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 14/03/14 14:55

Allora, vediamo di stringere...
Dal tuo codice ho capito che le celle da prelevare da Riassunto e scrivere sul file di uscita, foglio "Scheda", sono:
B2 --> C6 (vedi nota 1)
D2 --> G23
E2 --> G25
F2 --> G19
G2 --> G21
I2 --> G31
J2 --> G41
K2 --> G45
L2 --> G47
Nel ciclo successivo tutte le celle di origine scivolano di una posizione verso il basso, mentre la destinazione rimane invariata.
Nota1: la cella C6 viene sistematicamente compilata come detto sopra, salvo che poi detto valore viene sostituito col nominativo che sara' usato cone nome file. Tanto varrebbe allora evitare di copiare B2 in C2... ma B2 e sottostanti in realta' gia' contengono il nominativo che sara' usato per salvare il file, quindi in realta' quello che non capisco e' perche', dopo aver fatto la copia in C6 di un valore che dovrebbe gia' essere giusto, riscrivi in C6 lo stesso valore.
Nell' ignoranza ho mantenuto il tuo ciclo, e in C6 ci scrivo il nome del file.

Cio' detto,
-ho estratto dal tuo codice un solo ciclo
-l' ho inserito in un loop per ripeterlo il numero di volte che e' scritto in B16; la macro comunque si interrompe se Bxx e' vuota.
-ho modificato la selezione delle celle da cui copi i valori
-ho modificato la selezione del secondo workbook, che ora ha un nome variabile
-ho modificato la directory di salvataggio file, che NON E' PIU' direttamente il desktop ma una directory PIPPO posizionata sul desktop; questa directory la devi creare prima di avviare la macro.

Il risultato e' questa macro:
Codice: Seleziona tutto
Sub Prova2()
'
' Prova Macro
'
Dim StartNm As String, I As Long, LoopCNT As Long, FName As String, WB2 As String
'
StartNm = "B2"      '<<< La cella dove COMINCIANO i nomi da usare nel SalvaConNome
'
LoopCNT = Range("B16").Value
Workbooks.Open Filename:="C:\Users\Sara.PC-Sonia\Desktop\File di base.xls"
WB2 = ActiveWorkbook.Name
'Application.ScreenUpdating = False
'
For I = 1 To LoopCNT
FName = ThisWorkbook.Sheets("scheda").Range(StartNm).Offset(I - 1, 0).Value
If FName = "" Then Exit For
If Right(FName, 4) <> ".xls" Then FName = FName & ".xls"
'
    Windows("Riassunto.xlsm").Activate
    Sheets("scheda").Select
    Range("B2").Offset(I - 1, 0).Select
    Selection.Copy
    Windows(WB2).Activate
    ActiveWindow.SmallScroll Down:=-13
    Range("C6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("D2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    Range("G23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("E2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    Range("G25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("F2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    Range("G19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("G2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    Range("G21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("I2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    ActiveWindow.SmallScroll Down:=3
    Range("G31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("J2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    ActiveWindow.SmallScroll Down:=8
    Range("G41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("K2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    ActiveWindow.SmallScroll Down:=6
    Range("G45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Riassunto.xlsm").Activate
    Range("L2").Offset(I - 1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WB2).Activate
    Range("G47").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-20
    Range("C6").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = FName    ' ???  "Samuel"
'    ChDir "C:\Users\Sara.PC-Sonia\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Sara.PC-Sonia\Desktop\PIPPO\" & FName, FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
       
WB2 = ActiveWorkbook.Name

Next I
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub

Controlla il contenuto dell' istruzione marcata <<<.
Lo schermo ballera' tutto durante l' esecuzione della macro, visto che si seleziona in continuazione un file e l' altro; scandaloso per i programmatori che hanno un mese di esperienza, eccitante per i dilettanti alle prime armi che vedono come una macro che hanno registrato con le proprie mani con poche modifiche risolve problemi complessi.
Basterebbe mettere "Application.ScreenUpdating = False" all' inizio del codice per non vedere piu' questa animazione (in realta' basta togliere l' apostrofo in testa all' istruzione inserita verso l' inizio del loop).

Quando confermi che funziona, a scopo puramente dimostrativo, vedremo come puoi condensare il grosso della macro in 10 righe.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 18/03/14 16:06

Errore di run-time '9':
Indice non incluso nell'intervallo
:cry:
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 20/03/14 01:36

Se ti interessa che ci ragioniamo e' meglio che dici su quale riga del codice capita il fatto: premi Debug e dicci quale istruzione risulta evidenziata nel listing.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 23/03/14 10:50

viene evidenziata questa istruzione:

FName = ThisWorkbook.Sheets("scheda").Range(StartNm).Offset(I - 1, 0).Value

che vuol dire? che devo fare??
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 23/03/14 22:39

Io avevo chiesto:
partendo da Riassunto-Foglio2, avvii la registrazione macro:devi diligentemene:
a) selezionare Foglio3
b) aprire il secondo file
c) selezionae Foglio1


Tu hai risposto:
'
Sheets("scheda").Select
Windows("Riassunto.xlsm").Activate
Range("B2").Select
Selection.Copy
Windows("File di base.xls").Activate


Completando poi con
Manca questa istruzione iniziale:
Workbooks.Open Filename:="C:\Users\Sara.PC-Sonia\Desktop\File di base.xls"
Sheets("scheda").Select


Da questo io ho dedotto che
-quello che sul file Riassunto chiamavamo Foglio3 in realta' si chiama "scheda"
-quello che sul secondo file chiamavamo Foglio1 in realta' si chiama anche lui "scheda"

Evidentemente questa deduzione era errata, e nel file Riassunto (che e' quello in cui va inserita la macro) non c' e' un foglio "scheda"; come si chiama, quindi, sul file "Riassunto.xlsm" il foglio da cui i dati vanno prelevati?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 24/03/14 16:26

Quello di cui ho bisogno è:
prendere i dati da "Foglio 3" del file "Riassunto"
e inserirli in "scheda" del "File di base"
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 25/03/14 02:28

Quello di cui ho bisogno è:
prendere i dati da "Foglio 3" del file "Riassunto"
e inserirli in "scheda" del "File di base"

Nella macro che avevi registrato non c' e' traccia di una Sheets("Foglio3").Select, per cui avevo dedotto altro...
Cambia l' istruzione che va in errore in
Codice: Seleziona tutto
FName = ThisWorkbook.Sheets("Foglio3").Range(StartNm).Offset(I - 1, 0).Value


Che sia la volta buona?
Ciao, fai sapere.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 25/03/14 11:42

FINALMENTE FUNZIONA!!!! :D
Non da errori e crea i file excel che volevo (con il nome giusto)!
C'è ancora qualche problema...nel senso che qualche cella non me la copia...se mi dici come faccio a condensare qualche istruzione, però, forse riesco a risolvere da sola! :roll:
G R A Z I E !!!!!
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 25/03/14 13:07

In serata ti mando il codice che consensa il loop in una decina di righe.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per compilare un file excel

Postdi *sara* » 25/03/14 15:37

Ok. Grazie ancora dell'aiuto! ;)
Un'ultima cosa...una volta inseriti i dati di una riga e quindi salvata una copia del "File di base" con il giusto nome, voler salvare in pdf il foglio "Conto" contenuto all'interno del file (e chiamarlo con lo stesso nome del file generato) è chiedere troppo?? :oops:
Avatar utente
*sara*
Utente Junior
 
Post: 48
Iscritto il: 06/03/14 11:34

Re: [Excel] Macro per compilare un file excel

Postdi Anthony47 » 25/03/14 22:45

Questa e' una versione "ridotta" della macro precedente, compreso l' esportazione in pdf del foglio "Conto" (cambia di volta in volta, a seconda di come abbiamo popolato il foglio "scheda", vero?).
Codice: Seleziona tutto
Sub Prova3()
'
Dim StartNm As String, I As Long, LoopCNT As Long, FName As String, WB2 As String
Dim Sorg, PdfName As String
'
StartNm = "B2"      '<<< La cella dove COMINCIANO i nomi da usare nel SalvaConNome
'
LoopCNT = Range("B16").Value
Workbooks.Open Filename:="C:\Users\Sara.PC-Sonia\Desktop\File di base.xls"
'Application.ScreenUpdating = False
'
For I = 1 To LoopCNT
    FName = ThisWorkbook.Sheets("Foglio3").Range(StartNm).Offset(I - 1, 0).Value
    If FName = "" Then Exit For
    If Right(FName, 4) <> ".xls" Then FName = FName & ".xls"
'
    Set Sorg = ThisWorkbook.Sheets("Foglio3")
    Range("C6").Value = Sorg.Range("B2").Offset(I - 1, 0).Value
    Range("G23").Value = Sorg.Range("D2").Offset(I - 1, 0).Value
    Range("G25").Value = Sorg.Range("E2").Offset(I - 1, 0).Value
    Range("G19").Value = Sorg.Range("F2").Offset(I - 1, 0).Value
    Range("G21").Value = Sorg.Range("G2").Offset(I - 1, 0).Value
    Range("G31").Value = Sorg.Range("I2").Offset(I - 1, 0).Value
    Range("G41").Value = Sorg.Range("J2").Offset(I - 1, 0).Value
    Range("G45").Value = Sorg.Range("K2").Offset(I - 1, 0).Value
    Range("G47").Value = Sorg.Range("L2").Offset(I - 1, 0).Value
'
'di questa gia' nella macro di prima non ero sicuro...
    Range("C6").FormulaR1C1 = FName    ' ???  "Samuel"
'
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Sara.PC-Sonia\Desktop\PIPPO\" & FName, FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
'
'per creare il pdf del foglio Conto:
    PdfName = Replace("C:\Users\Sara.PC-Sonia\Desktop\PIPPO\" & FName, ".xls", "")
    Sheets("Conto").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfName _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False
       
Next I
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub

Come vedi e' abbastanza piu' semplice della precedente, ma ho voluto mostrarti come registrando una macro e poi modificandola di poco si riescono a ottenere risultati insperati.
Quindi continua a registrare le tue macro, ti daranno molte soddisfazioni con poco.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "[Excel] Macro per compilare un file excel":


Chi c’è in linea

Visitano il forum: Nessuno e 52 ospiti