Selezionare range

[elios66]

Ciao a tutti,
sono nuovo e desidero avere il vostro aiuto.
Ho un file Excel in un foglio ho delle categorie disposte per riga es: cod, titolo, sigla - cod, titolo, sigla - ecc
con di sotto i vari articoli. Tramite vba desidero copiarle in un altro foglio ma una sotto l'altra.
es:
cod, titolo, sigla
art1
art2
ecc
cod, titolo, sigla
art1
art2
art3
ecc
ecc

Codice: Seleziona tutto

Sub Aggiorna_Modello()

colonna = 1
j = 1
Application.ScreenUpdating = False
Sheets("ModelloMese").Visible = True
   
    Sheets("ModelloMese").Select
    Range("A2").Select
    Selection.End(xlDown).Offset(0, 2).Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
   
Sheets("Pubblicazioni").Visible = True
Sheets("Pubblicazioni").Select

Do Until Sheets("Pubblicazioni").Cells(j, colonna) = Empty
    Cells(j, colonna).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.Offset(0, 2)).Select
    Selection.Copy
    Sheets("ModelloMese").Select
    Range("A2").Select
    If Range("A2").Value = "" Then GoTo 20
    Selection.End(xlDown).Offset(1, 0).Select
20  ActiveSheet.Paste
colonna = colonna + 4

Loop
Aggiorna_ws1

End Sub

Questo è il codice che sto usando al momento ma mi da errore alla riga 20
Vi ringrazio per l'aiuto che vorrete darmi.

[ricky53]

Ciao,
con l'istruzione

Codice: Seleziona tutto

        Selection.End(xlDown).Offset(1, 0).Select


tu lo fai andare giù fino alla prima cella con dati ma evidentemente, nella colonna, dopo la riga selezionata non ci sono altri dati ed arriva fino a fine foglio e poi gli chiedi di spostarsi una riga in basso e va fuori foglio

Prova con quest'altra istruzione

Codice: Seleziona tutto

        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select


[elios66]

Ciao Ricky,
grazie per la risposta.
Ho provato il tuo codice, ma mi da errore alla riga 20 dicendo che le aree di copia/incolla non sono uguali.

[elios66]

Questo è il foglio Pubblicazione da cui prende i dati dalle colonne

[ricky53]

Ciao,
non hai inserito correttamente il link al tuo file.


Ho qualche dubbio su come sono organizzati i dati ... e premesso che il tuo codice fa delle cose che non servono ed utilizza Select che non dovrebbero utilizzarsi che potrebbero essere la causa di errori ... VORREI ma non ho il tempo di riorganizzarti il codice, quindi, ti invio una semplice modifica (aggiunta di .Sekect al foglio "Pubblicazioni") al tuo codice

Codice: Seleziona tutto

Do Until Sheets("Pubblicazioni").Cells(j, colonna) = Empty
    Sheets("Pubblicazioni").Select ' <<===== AGGIUNTA ADESSO
    Cells(j, colonna).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.Offset(0, 2)).Select
    Selection.Copy
    Sheets("ModelloMese").Select
    Range("A2").Select
    If Range("A2").Value = "" Then GoTo 20
'    Selection.End(xlDown).Offset(1, 0).Select ' <<===== TOLTA
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select ' <<===== AGGIUNTA PRIMA
20  ActiveSheet.Paste
colonna = colonna + 4

Loop


Io ho provato su un file che mi sono auto costruito ricavando l'organizzazione dei dati dal codice ... con quanto ne potrebbe seguire, però non ho avuto errori ed ha copiato tre colonne ogni ciclo del loop.

Provalo e ... sono QUI

[elios66]

[img][/img]

[ricky53]

Ciao,
hai provato la macro con il codice che ho aggiunto ?

[elios66]

[img][IMG]http://imagizer.imageshack.us/v2/640x480q90/542/q2p5.jpg[/img][/img]

[elios66]

si ho provato ma non copia.
ho postato il foglio ModelloMese
così ti puoi rendere conto.
Grazie
se vuoi ti posto il file completo, ma dimmi come fare

[elios66]

http:/..
ecco il link al file

[elios66]

Fatto! Funziona, grazie

[elios66]

Ora però l'errore me lo fa in questa macro

Codice: Seleziona tutto

Sub Aggiorna_ws1()
...
colonna = 1
j = 2
Do Until Sheets("Pubblicazioni").Cells(j, colonna) = Empty
Sheets("Pubblicazioni").Visible = True
    Sheets("Pubblicazioni").Select
    Cells(j, colonna).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.Offset(0, 2)).Select
    Selection.Copy
    Sheets("Foglio1").Select
    Range("g2").Select
    If Range("g2").Value = "" Then GoTo 20
    'Selection.End(xlDown).Offset(1, 0).Select
    Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Select
20    ActiveSheet.Paste
colonna = colonna + 4

Loop

[elios66]

Adesso non lo fa più. MISTERO.
Ma se puoi aiutarmi. Nella form vedi che ci sono due listbox cliccando sulle varie voci della listbox1 mi dice: "Errore di run time 380:
Impossibile impostare la proprietà ListIndex. Valore della proprietà non valido."
Come posso fare?

[elios66]

[img][IMG]http://imagizer.imageshack.us/v2/320x240q90/37/cef3.jpg[/img][/img]

[elios66]

[ricky53]

Ciao,
invia il codice utilizzato ed evidenzia l'istruzione che va in errore

[elios66]

Codice: Seleziona tutto

Option Explicit
Dim posiz As Integer, p As Integer, i As Integer, art


Private Sub UserForm_Initialize()

    Dim intIndex As Integer

    ListBox1.RowSource = ("Setup!H1:H101")
    ListBox2.RowSource = ("Setup!H1:H101")

    ListBox1.TopIndex = ListBox1.ListCount - 1
    ListBox2.TopIndex = ListBox1.ListCount - 1
    ScrollBar1.Max = 26 - (ListBox1.ListCount - ListBox1.TopIndex)
    ScrollBar2.Max = 26 - (ListBox1.ListCount - ListBox1.TopIndex)
    ListBox1.TopIndex = 0
    ListBox2.TopIndex = 0
    With Frame1
        .BorderStyle = fmBorderStyleNone
        .Height = ListBox1.Height
        .Width = ListBox1.Width - 15
    End With
    With Frame2
        .BorderStyle = fmBorderStyleNone
        .Height = ListBox1.Height
        .Width = ListBox1.Width - 15
    End With
    ScrollBar1.Top = Frame1.Top
    ScrollBar2.Top = Frame2.Top
    ScrollBar1.Height = Frame1.Height
    ScrollBar2.Height = Frame2.Height
    ScrollBar1.Left = Frame1.Left + Frame1.Width
    ScrollBar2.Left = Frame2.Left + Frame1.Width
End Sub

Private Sub ListBox1_Change()
  Dim list1, list2
  list1 = ListBox1.ListIndex
  ListBox2.TopIndex = ListBox1.TopIndex
  ListBox2.ListIndex = list1   '<-----------------------------QUESTA DA ERRORE
End Sub


Private Sub ListBox2_Change()
  Dim list1, list2
  list1 = ListBox2.ListIndex
  ListBox1.TopIndex = ListBox2.TopIndex
  ListBox1.ListIndex = list1
End Sub

Private Sub ScrollBar1_Change()
    ListBox1.TopIndex = ScrollBar1.Value
    ScrollBar2.Value = ScrollBar1.Value
End Sub

Private Sub ScrollBar2_Change()
    ListBox2.TopIndex = ScrollBar2.Value
    ScrollBar1.Value = ScrollBar2.Value
End Sub


[ricky53]

Ciao,
probabilmente tu stai impostando le righe della Listbox2 con un valore troppo grande (quello che hai selezionato con la "ListBox1").

Controlla: RowSource di entrambi e vedi che riga hai selezionato.


Prova a selezionare la seconda riga della "ListBox1" e ...

[elios66]

Ciao
ho notato che da errore quando seleziono l'ultima voce della listbox1 e poi seleziono un'altra voce. Non ho capito bene cosa volevi dire tu, ho diminuito il range del RowSource da 101 a 20, ma non funziona.

[elios66]

http://www.filedropper.com/s28-forum2ok_1
Ecco il file completo.