Newsgroup: it.comp.lang.visual-basic
Titolo: macro x excel

mi occorre una macro che controlli la colonna L del foglio2 e quindi se in
una o più celle c'è il segno X, deve tagliare l'intera riga e copiarla
nella  prima riga/he libera/e del foglio5....io ho già provato, ma  riesco
solo a copiare la riga in questione senza cancellarla, oppire mi si
incanta il pc durante il debug...aiuto!!!!!!
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 incanta il pc durante il debug...aiuto!!!!!!
    Magari se ci facevi vedere il codice si poteva tentare di dirti cosa non
andava. Senno' che facciamo? Te lo scriviamo noi? Vabbe', per stavolta...
Facci sapere se ci son problemi.
Option Explicit
Public Sub iclvbXCinzia()
  Const c_sWshSrcName = "Foglio2"
  Const c_sWshDstName = "Foglio5"
  Const c_lColCrit = 12
  Const c_sCritVal = "X"
  Dim oXlWshSrc     As Excel.Worksheet
  Dim oXlRngSrc     As Excel.Range
  Dim oXlRngCrit    As Excel.Range
  Dim oXlRngCritCur As Excel.Range
  Dim oXlWshDst     As Excel.Worksheet
  Dim oXlRngDst     As Excel.Range
  With Excel.ActiveWorkbook.Worksheets
    Set oXlWshSrc = .Item(c_sWshSrcName)
    Set oXlWshDst = .Item(c_sWshDstName)
  End With
  With oXlWshSrc
    Set oXlRngCrit _
      = .Range( _
            .Cells(1, c_lColCrit) _
          , .Cells( _
                .UsedRange(.UsedRange.Rows.Count, 1).Row _
              , c_lColCrit))
    Debug.Print oXlRngCrit.Address
  End With
  For Each oXlRngCritCur In oXlRngCrit
    With oXlRngCritCur
      If (.Value = c_sCritVal) Then
        If (oXlRngSrc Is Nothing) Then
          Set oXlRngSrc = .EntireRow
        Else
          Set oXlRngSrc = Union(oXlRngSrc, .EntireRow)
        End If
      End If
    End With
  Next
  If (oXlRngSrc Is Nothing) Then
    ' Nothing to do
  Else
    With oXlWshDst.UsedRange
      Set oXlRngDst = .Resize(1, 1).Offset(.Rows)
    End With
    Debug.Print oXlRngDst.Address
    With oXlRngSrc
      .Select
      .Copy oXlRngDst
      .Delete
    End With
  End If
  Set oXlRngDst = Nothing
  Set oXlWshDst = Nothing
  Set oXlRngCritCur = Nothing
  Set oXlRngCrit = Nothing
  Set oXlRngSrc = Nothing
  Set oXlWshSrc = Nothing
End Sub
--
Ciao.
Maurizio
--------
?SPQR(C)
 X
--------

 andava. Senno' che facciamo? Te lo scriviamo noi? Vabbe', per stavolta...
Anche tu, come vedi, sei un "sorvegliato speciale" (poi me la spiegherai,
ehhh!).
Ah, ma che volevo dire? ... "Tira più un ... che un carro di buoi".
Nevvero?! ;-)

 incanta il pc durante il debug...aiuto!!!!!!
Sub Macro1()
 Dim i As Integer 'riga corrente sul foglio 1
 Dim j As Integer 'riga corrente sul foglio 2
 i = 1
 j = 0
    Do
        If Cells(i, 12).Value = "X" Then
            j = j + 1
            Rows(i).Cut
            Sheets("destinazione").Select
            Rows(j).Select
            ActiveSheet.Paste
            Sheets("origine").Select
        Else
            i = i + 1
        End If
    Loop Until Cells(i, 12).End(xlDown).Row = 65536
    'esce dal ciclo quando non ci sono piu' caratteri sulla colonna L
End Sub
ovviamente al posto di "origine" e "destinazione" devi mettere i nomi dei
fogli o il loro indice.
--
Ciao, Silv:o)

     'esce dal ciclo quando non ci sono piu' caratteri sulla colonna L
    Loop Until i = 65536
..pero' i va dichiarato come Long
--
Silv:o)

 Nevvero?! ;-)
    Volgare, inopportuno, indelicato e... allupato. La mia personale storia
di ng dice che sono una persona molto distinta, civile e a modo con tutti.
    Tie'.


     Tie'.
:o( = Basito!
Mah!

 Mah!
    Ovvio che tu sia restato basito. Come puoi comprendere il mio fastidio
se non e' anche il tuo?


 se non e' anche il tuo?
Ok. No Comment.