Continuo a modificarlo e quindi l'upload diventa inutile.. Speravo non fosse necessario.
Ora lo sto rifacendo..La connessione è piuttosto lenta, fra circa 40min ti copio il link
Ciao,
Fabio
Moderatori: Anthony47, Flash30005
Sub format()
'
' format Macro
'
'
Columns("AL:AL").Select
End Sub
Sub format2()
'
' format2 Macro
'
'
Columns("AL:AL").Select
Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("AL:AL").Select
Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Find(What:=".", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Range("AL2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Find(What:=".", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Range("AI65529").Select
ActiveWindow.ScrollRow = 65504
ActiveWindow.ScrollRow = 65292
ActiveWindow.ScrollRow = 64869
ActiveWindow.ScrollRow = 62012
ActiveWindow.ScrollRow = 48573
ActiveWindow.ScrollRow = 45398
ActiveWindow.ScrollRow = 31112
ActiveWindow.ScrollRow = 25186
ActiveWindow.ScrollRow = 24657
ActiveWindow.ScrollRow = 23493
ActiveWindow.ScrollRow = 21800
ActiveWindow.ScrollRow = 4340
ActiveWindow.ScrollRow = 1
End Sub
Sub Macro3()
'
' Macro3 Macro
'
'
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
Columns("P:P").Select
Selection.Copy
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 19
Columns("AL:AL").Select
ActiveSheet.Paste
Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub Importa3()
Perc = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.Calculation = xlManual
For RR1 = 12 To 15
Worksheets("Analisi DUVRI").Select
Nomefile = Range("N" & RR1).Text & ".xls"
Select Case RR1
Case Is = 12
ColI = "A"
ColF = "AC"
NomeFoglio = "Stato PdL"
Case Is = 13
ColI = "A"
ColF = "AI"
NomeFoglio = "Attivazioni"
Case Is = 14
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri"
Case Is = 15
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri ieri"
End Select
Workbooks.Open Filename:=Perc & Nomefile
Columns(ColI & ":" & ColF).Copy Destination:=Workbooks("Duvri Master.xls").Worksheets(NomeFoglio).Columns(2)
Application.DisplayAlerts = False
Workbooks(Nomefile).Close SaveChanges:=False
Application.DisplayAlerts = True
Next RR1
'.... aggiunte queste righe
Worksheets("Attivazioni").Select
UR = Range("P" & Rows.Count).End(xlUp).Row
Range("P2:P" & UR).Copy Destination:=Range("AL2")
For RR = 2 To UR
Datam = Range("AL" & RR).Value
Range("AL" & RR).Value = DateSerial(Mid(Datam, 7, 4), Mid(Datam, 4, 2), Mid(Datam, 1, 2))
Next RR
'fine modifica
Worksheets("Analisi DUVRI").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Importa3()
Perc = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.Calculation = xlManual
For RR1 = 12 To 15
Worksheets("Analisi DUVRI").Select
Nomefile = Range("N" & RR1).Text & ".xls"
Select Case RR1
Case Is = 12
ColI = "A"
ColF = "AC"
NomeFoglio = "Stato PdL"
Case Is = 13
ColI = "A"
ColF = "AI"
NomeFoglio = "Attivazioni"
Case Is = 14
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri"
Case Is = 15
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri ieri"
End Select
Workbooks.Open Filename:=Perc & Nomefile
Columns(ColI & ":" & ColF).Copy Destination:=Workbooks("Duvri Master.xls").Worksheets(NomeFoglio).Columns(2)
Application.DisplayAlerts = False
Workbooks(Nomefile).Close SaveChanges:=False
Application.DisplayAlerts = True
Next RR1
Worksheets("Attivazioni").Select
UR = Range("P" & Rows.Count).End(xlUp).Row
Range("P2:P" & UR).Copy Destination:=Range("AL2")
For RR = 2 To UR
Datam = Range("AL" & RR).Value
Range("AL" & RR).Value = DateSerial(Mid(Datam, 7, 4), Mid(Datam, 4, 2), Mid(Datam, 1, 2))
Next RR
'aggiunte queste righe di codice per l'ultimo quesito
Worksheets("KPI report").Select
Cells.Copy
Workbooks.Open Filename:=Perc & "KPI_Master.xls"
Worksheets("KPI report").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Workbooks("KPI_Master.xls").Close SaveChanges:=True
'fine modifica copia valori
Worksheets("Analisi DUVRI").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Importa3()
Perc = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.Calculation = xlManual
For RR1 = 12 To 15
Worksheets("Analisi DUVRI").Select
Nomefile = Range("N" & RR1).Text & ".xls"
Select Case RR1
Case Is = 12
ColI = "A"
ColF = "AC"
NomeFoglio = "Stato PdL"
Case Is = 13
ColI = "A"
ColF = "AI"
NomeFoglio = "Attivazioni"
Case Is = 14
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri ieri"
Case Is = 15
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri 2gg fa"
End Select
Workbooks.Open Filename:=Perc & Nomefile
Columns(ColI & ":" & ColF).Copy Destination:=Workbooks("Duvri Master.xls").Worksheets(NomeFoglio).Columns(2)
Application.DisplayAlerts = False
Workbooks(Nomefile).Close SaveChanges:=False
Application.DisplayAlerts = True
Next RR1
Worksheets("Attivazioni").Select
UR = Range("P" & Rows.Count).End(xlUp).Row
Range("P2:P" & UR).Copy Destination:=Range("AL2")
For RR = 2 To UR
Datam = Range("AL" & RR).Value
Range("AL" & RR).Value = DateSerial(Mid(Datam, 7, 4), Mid(Datam, 4, 2), Mid(Datam, 1, 2))
Next RR
'aggiunte queste righe di codice per l'ultimo quesito
Worksheets("KPI report").Select
Cells.Copy
Workbooks.Open Filename:=Perc & "KPI Master.xls"
Worksheets("KPI report").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Workbooks("KPI Master.xls").Close SaveChanges:=True
'fine modifica copia valori
Worksheets("Analisi DUVRI").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Dim pt As PivotTable
For Each pt in ActiveSheet.PivotTables
pt. RefreshTable
Next pt
...
Next RR '<<< esistente
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Inserisci qui le righe di codice sopra menzionate
'aggiunte queste righe di codice per l'ultimo quesito '<<<< commento esistente
Sub Importa3()
Perc = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.Calculation = xlManual
For RR1 = 12 To 15
Worksheets("Analisi DUVRI").Select
Nomefile = Range("N" & RR1).Text & ".xls"
Select Case RR1
Case Is = 12
ColI = "A"
ColF = "AC"
NomeFoglio = "Stato PdL"
Case Is = 13
ColI = "A"
ColF = "AI"
NomeFoglio = "Attivazioni"
Case Is = 14
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri ieri"
Case Is = 15
ColI = "A"
ColF = "K"
NomeFoglio = "Duvri 2gg fa"
End Select
Workbooks.Open Filename:=Perc & Nomefile
Columns(ColI & ":" & ColF).Copy Destination:=Workbooks("Duvri Master.xls").Worksheets(NomeFoglio).Columns(2)
Application.DisplayAlerts = False
Workbooks(Nomefile).Close SaveChanges:=False
Application.DisplayAlerts = True
Next RR1
Worksheets("Attivazioni").Select
UR = Range("P" & Rows.Count).End(xlUp).Row
Range("P2:P" & UR).Copy Destination:=Range("AL2")
For RR = 2 To UR
Datam = Range("AL" & RR).Value
Range("AL" & RR).Value = DateSerial(Mid(Datam, 7, 4), Mid(Datam, 4, 2), Mid(Datam, 1, 2))
Next RR '<<< esistente
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim pt As pivotTable
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
Next pt
'aggiunte queste righe di codice per l'ultimo quesito
Worksheets("KPI report").Select
Cells.Copy
Workbooks.Open Filename:=Perc & "KPI Master.xls"
Worksheets("KPI report").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Workbooks("KPI Master.xls").Close SaveChanges:=True
'fine modifica copia valori
Worksheets("Analisi DUVRI").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
camillobenzo ha scritto:...poi apre un altra pagina microsoft excel con lo stesso nome "Duvri master...
Torna a Applicazioni Office Windows
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Visitano il forum: Nessuno e 48 ospiti