[Excel] Tabelle per Statistiche Calcio

[dome10]

Salve ragazzi, sto creando un file di statistiche calcio, importo le tabelle totale, home, away per ogni singolo campionato in unico foglio, problema è che vorrei copiare nel foglio "totale" tutte le tabelle totali dei vari campionati, nel foglio "home" tutte le tabelle home, nel foglio "away" tutte le tabelle away .Spero di essere stato chiaro
allego file.
http://www.filedropper.com/provasta

[Flash30005]

Ciao Dome10 e benvenuto nel Forum

Inserisci in un modulo questa macro e avviala

Codice: Seleziona tutto

Sub TrascTab()
Dim FC As Worksheet
Dim FH As Worksheet
Dim FA As Worksheet
Set FC = Worksheets("classifiche")
Set FH = Worksheets("home")
Set FA = Worksheets("away")
FH.Cells.Clear
FA.Cells.Clear
Application.ScreenUpdating = False
Application.Calculation = xlManual
URC = FC.Range("A" & Rows.Count).End(xlUp).Row
WS = ""
RigaI = 0
RigaF = 0
For RRC = 1 To URC
    If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "HOME" Then
       Set WS = FH
        RigaI = RRC
    Else
        If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "AWAY" Then
            Set WS = FA
            RigaI = RRC
        End If
    End If
    If RigaI > 0 Then
        If UCase(Left(Trim(FC.Range("A" & RRC).Value), 6)) = "LEAGUE" Then
            RigaF = RRC
            URW = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
            FC.Range("A" & RigaI & ":I" & RigaF).Copy Destination:=WS.Range("A" & URW)
        RRC = RigaF
        End If
End If
Next RRC
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Ciao

[dome10]

Ciao Flash, grazie della macro, provandola ho riscontrato dei problemi, per il foglio "totali" non copia tabella mentre nel foglio "away"mi copia sia la tabella totale e poi mi ripete due volte la tabella away.Ti allego foto(per il foglio Away ho nascosto alcune righe per farle entrare nell'immagine).Grazie
Foglio Away

invia immagini
Foglio Totali

upload

[Flash30005]

Per la duplicazione tabella in foglio Away devi aggiungere solo il reset rigaI in questo punto

Codice: Seleziona tutto

            RRC = RigaF  '<<<<<<<<<<<<<<< esistente
            RigaI = 0        '<<<<<<<<<<<<<<< <<<< aggiungere
      End If                 '<<<<<<<<<<<<<<< esistente


per quanto riguarda il foglio totali non so cosa vorresti avere
la copia del foglio classifiche?

ciao

[dome10]

Grazie Flash, nella Foglio "totali" vanno tutte le prime tabelle dei vari campionati(quelle con intestazione "Matches of...").
Ti allego immagine

host immagini
Io ho provato, cosi ma nel Foglio "totali" non trovo niente (come vedi sono newbie con vba)

Codice: Seleziona tutto

Sub TrascTab()
    Dim FC As Worksheet
    Dim FT As Worksheet
    Dim FH As Worksheet
    Dim FA As Worksheet
    Set FC = Worksheets("classifiche")
    Set FT = Worksheets("totale")
    Set FH = Worksheets("home")
    Set FA = Worksheets("away")
    FT.Cells.Clear
    FH.Cells.Clear
    FA.Cells.Clear
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    URC = FC.Range("A" & Rows.Count).End(xlUp).Row
    WS = ""
    RigaI = 0
    RigaF = 0
    For RRC = 1 To URC
        If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "MATCHES" Then
           Set WS = FT
            RigaI = RRC
        Else
         
          If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "HOME" Then
           Set WS = FH
            RigaI = RRC
        Else
            If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "AWAY" Then
                Set WS = FA
                RigaI = RRC
            End If
        End If
        If RigaI > 0 Then
            If UCase(Left(Trim(FC.Range("A" & RRC).Value), 6)) = "LEAGUE" Then
                RigaF = RRC
                URW = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
                FC.Range("A" & RigaI & ":I" & RigaF).Copy Destination:=WS.Range("A" & URW)
              RRC = RigaF
            RigaI = 0
      End If
     
      End If
   End If
   
    Next RRC
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub


[Flash30005]

Forse così?

Codice: Seleziona tutto

Sub TrascTab()
Dim FC As Worksheet
Dim FH As Worksheet
Dim FA As Worksheet
Dim FT As Worksheet
Set FC = Worksheets("classifiche")
Set FH = Worksheets("home")
Set FA = Worksheets("away")
Set FT = Worksheets("totale")
FH.Cells.Clear
FA.Cells.Clear
FT.Cells.Clear
Application.ScreenUpdating = False
Application.Calculation = xlManual
URC = FC.Range("A" & Rows.Count).End(xlUp).Row
ws = ""
RigaI = 0
RigaF = 0
For RRC = 1 To URC
    If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "HOME" Then
       Set ws = FH
        RigaI = RRC
    Else
        If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "AWAY" Then
            Set ws = FA
            RigaI = RRC
        Else
           If UCase(Left(FC.Range("A" & RRC).Value, 4)) = "MATC" Then
           Set ws = FT
           RigaI = RRC
           End If
        End If
    End If
    If RigaI > 0 Then
        If UCase(Left(Trim(FC.Range("A" & RRC).Value), 6)) = "LEAGUE" Then
            RigaF = RRC
            URW = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
            FC.Range("A" & RigaI & ":I" & RigaF).Copy Destination:=ws.Range("A" & URW)
            RRC = RigaF
            RigaI = 0
        End If
End If
Next RRC
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Come newbie non male
applicati un po' di più perché si tratta di capire la logica e le macro che posto sono user friendly

ciao

[dome10]

Grazie Flash, era quello che cercavo.