IALweb Homepage
Forum Home Forum Home > MS Office > Microsoft Office > Microsoft Excel
  New Posts New Posts RSS Feed - [RISOLTO] Copia valori tra due files
  FAQ FAQ  Forum Search   Events   Register Register  Login Login

REGISTRATEVI su IALWeb forum! E' facile e veloce! Potrete consultare tutte le sezioni del forum senza restrizioni e scrivere per dare o richiedere aiuto.
Votaci in Net-Parade

[RISOLTO] Copia valori tra due files

 Post Reply Post Reply
Author
Message
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 2327
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Topic: [RISOLTO] Copia valori tra due files
    Posted: 11/Gen/2017 at 15:39
Ciao a Tutti,

ho un file.xlsm che contiene un foglio "Commesse" del quale voglio estrarre solo alcuni valori presenti in colonna H e I.

Precisamente:

          H       I
...
riga9   111  descrizione A
riga10  222  descrizione B
riga11  
riga12  333  descrizione C
riga13
riga14
riga15  444   descrizione D
...
riga234 999  descrizione C
riga235       finale

voglio estrarre tutti i valori H9:IXX
dove XX = ultimo valore utile e non vuoto letto in colonna H.

Quindi nell' esempio in questione la riga contenente la parola "finale" non deve essere presa in considerazione.

Riporto il codice, funzionante al 90%,

Sub copia_M()

    Dim wkb1 As Workbook, wkb2 As Workbook, wks1 As Worksheet, wks2 As Worksheet
    Dim lastrow As Long, r As Long

    Application.ScreenUpdating = False

    Set wkb1 = Application.Workbooks.Open("\\server\file_" & Format(Month(Date), "00") & ".xlsm")
    Set wks1 = wkb1.Sheets("Commesse")
    Set wkb2 = ThisWorkbook
    Set wks2 = wkb2.Sheets("Foglio1")
    wkb2.Sheets("Foglio1").Range("A:C").ClearContents


    lastrow = wks1.Range("H" & Rows.Count).End(xlUp).Row
    UR = wks1.Range("H9:I" & lastrow).Cells.SpecialCells(xlCellTypeConstants).Count 
    For r = 1 To UR
        wks2.Cells(r, 1) = wks1.Cells(r + 8, 8)
        wks2.Cells(r, 2) = UCase(wks1.Cells(r + 8, 9))
        wks2.Cells(r, 3) = wks2.Cells(r, 1) & " | " & wks2.Cells(r, 2)
    Next

        wkb1.Close False
    Set wkb1 = Nothing
    Set wks1 = Nothing
    Set wks2 = Nothing


End Sub

Da vedere:
  • devo definire anche UR in dim ?
  • wkb2 va bene definito così ?
  • mi fa vedere anche la riga contente la parola "finale" Ouch

Grazie mille in anticipo !!



Edited by il_betto - 12/Gen/2017 at 10:37
Back to Top
Ricky53 View Drop Down
Amministratore
Amministratore
Avatar
Esperto di Excel e PowerPoint

Joined: 05/Ott/2006
Location: Italy
Status: Offline
Points: 16242
Post Options Post Options   Thanks (0) Thanks(0)   Quote Ricky53 Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2017 at 15:55
Ciao,
non capisco a cosa ti serva la
UR = wks1.Range("H9:I" & lastrow).Cells.SpecialCells(xlCellTypeConstants).Count 

Comunque se l'ultima cella della colonna  "H"  NON va MAI presa allora cambia
lastrow = wks1.Range("H" & Rows.Count).End(xlUp).Row

con
lastrow = wks1.Range("H" & Rows.Count).End(xlUp).Row - 1


AMMINISTRATORE

Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 2327
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2017 at 16:06
Ciao ricky53,

no, deve essere preso come numero di fine range, quello in cui  H presenti un valore non nullo.

L' esempio che ho postato e' per far vedere che il codice scritto non va bene in quanto viene importata anche la riga in cui compare la parola "finale" ma che e' in I.

Il range corretto e' quindi H9:I234 ...




Edited by il_betto - 11/Gen/2017 at 16:10
Back to Top
Ricky53 View Drop Down
Amministratore
Amministratore
Avatar
Esperto di Excel e PowerPoint

Joined: 05/Ott/2006
Location: Italy
Status: Offline
Points: 16242
Post Options Post Options   Thanks (0) Thanks(0)   Quote Ricky53 Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2017 at 16:43
Ciao,
non è chiaro.

Manda un file di esempio, senza dati riservati ma fittizi.
AMMINISTRATORE

Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 2327
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2017 at 17:07
Ciao Ricky53,

allego il file uploads/19358/pluto2.rar

Se uno lancia da un qualsiasi file excel il codice suddetto, vede che vengono caricate nel file 23 righe, anziche' le 22 che mi interessano.

Perche' ??

Ripeto poi: UR  va definita come dim ? wkb2 va bene definita cosi' ?


Sub copia_M()

    Dim wkb1 As Workbook, wkb2 As Workbook, wks1 As Worksheet, wks2 As Worksheet
    Dim lastrow As Long, r As Long

    Application.ScreenUpdating = False

    Set wkb1 = Application.Workbooks.Open("\\server\pluto.xlsm")

    Set wks1 = wkb1.Sheets("Commesse")
    Set wkb2 = ThisWorkbook
    Set wks2 = wkb2.Sheets("Foglio1")
    wkb2.Sheets("Foglio1").Range("A:C").ClearContents


    lastrow = wks1.Cells(Rows.Count, "H").End(xlUp).Row ' H ha 22 righe non 23
    UR = wks1.Range("H9:I" & lastrow).Cells.SpecialCells(xlCellTypeConstants).Count
    For r = 1 To UR
        wks2.Cells(r, 1) = wks1.Cells(r + 8, 8)
        wks2.Cells(r, 2) = UCase(wks1.Cells(r + 8, 9))
        wks2.Cells(r, 3) = wks2.Cells(r, 1) & " | " & wks2.Cells(r, 2)
    Next

        wkb1.Close False
    Set wkb1 = Nothing
    Set wks1 = Nothing
    Set wks2 = Nothing


End Sub


Edited by il_betto - 11/Gen/2017 at 17:07
Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 8427
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2017 at 17:12

Ciao

ma se al posto di:

For r = 1 To UR

metti

For r = 1 To lastrow

Sbaglio?

saluti


edit: non ho visto il file



Edited by dodo47 - 11/Gen/2017 at 18:27
domenico
win 10- office 2010
Back to Top
Ricky53 View Drop Down
Amministratore
Amministratore
Avatar
Esperto di Excel e PowerPoint

Joined: 05/Ott/2006
Location: Italy
Status: Offline
Points: 16242
Post Options Post Options   Thanks (0) Thanks(0)   Quote Ricky53 Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2017 at 20:33

Ciao,

io, prima, ti avevo chiesto a cosa servisse "UR" ....


Scarico il file e mi faccio risentire.

AMMINISTRATORE

Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione
Back to Top
Ricky53 View Drop Down
Amministratore
Amministratore
Avatar
Esperto di Excel e PowerPoint

Joined: 05/Ott/2006
Location: Italy
Status: Offline
Points: 16242
Post Options Post Options   Thanks (0) Thanks(0)   Quote Ricky53 Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2017 at 20:55

Ciao,

file scaricato e ... l'istruzione

    UR = wks1.Range("H9:I" & lastrow).Cells.SpecialCells(xlCellTypeConstants).Count

NON serve


Ecco il codice corretto

Sub copia_M()
    Dim wkb1 As Workbook, wkb2 As Workbook, wks1 As Worksheet, wks2 As Worksheet
    Dim lastrow As Long, r As Long
   
    Application.ScreenUpdating = False
    Set wkb1 = Application.Workbooks.Open("\\server\pluto.xlsm")
    Set wks1 = wkb1.Sheets("Commesse")
    Set wkb2 = ThisWorkbook
    Set wks2 = wkb2.Sheets("Foglio1")
    wkb2.Sheets("Foglio1").Range("A:C").ClearContents
    lastrow = wks1.Cells(Rows.Count, "H").End(xlUp).Row ' <<===== SERVE SOLO QUESTA
    For r = 9 To lastrow ' <<===== Modificata
        wks2.Cells(r - 8, 1) = wks1.Cells(r, 8) ' <<===== Modificata
        wks2.Cells(r - 8, 2) = UCase(wks1.Cells(r, 9)) ' <<===== Modificata
        wks2.Cells(r - 8, 3) = wks2.Cells(r - 8, 1) & " | " & wks2.Cells(r - 8, 2) ' <<===== Modificata
    Next
    wkb1.Close False
   
    Application.ScreenUpdating = True ' <<===== Aggiunta
    Set wkb1 = Nothing
    Set wks1 = Nothing
    Set wks2 = Nothing
End Sub


ATTENZIONE:

nel file di partenza la riga "24" è VUOTA e viene scritta lo stesso nel file di arrivo !!!

E' questo quello che ti occorre ???



Edited by Ricky53 - 11/Gen/2017 at 20:57
AMMINISTRATORE

Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 2327
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 12/Gen/2017 at 10:23
Ciao Ricky,

Perfettissimo, funziona alla grande !!! Complimenti !!! Clap Clap Clap

Edited by il_betto - 12/Gen/2017 at 10:37
Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.17
Copyright ©2001-2013 Web Wiz Ltd.

This page was generated in 0,156 seconds.