No no
è solo un test se funzionava bene
si aggiusta il tiro per far in modo di rendere la macro universale
Ti potrei spiegare del perché ma evito visto che non ti interessa...
Modificare questo codice è semplicissimo se ti funziona così
Moderatori: Anthony47, Flash30005
Application.CutCopyMode = False '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close SaveChanges:=False
Sheets("giornaliero").Select <<< si blocca qui e' il foglio dove deve incollare
Range("m7").Select ' la cella dove incollare i dati
ThisWorkbook.Activate
Public percorso, Nfile As String, FileC As Integer
Public masopen As Boolean
Function ckf(nomefile) As Boolean
For Each Wb In Workbooks
If Wb.Name = nomefile Then
FileC = 0
ckf = True: Exit Function
End If
Next Wb
End Function
Sub ApreFile()
FileC = 0
percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "Masa1.xls"
masopen = ckf("Masa1.xls")
If masopen = False Then
FileC = 1
Application.Workbooks.Open percorso & Nfile
End If
'Inserire qui cosa devi farci con Masa1 e file con macro
If FileC = 1 Then Workbooks("Masa1.xls").Close savechanges:=False
End Sub
Sub prel1()
Dim masopen As Boolean
ActiveSheet.Unprotect
masopen = ckf("masa1.xls") 'True=file gia' aperto
Application.ScreenUpdating = False
Application.Calculation = xlManual
percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & Nfile
Worksheets("1-masa1-Fogl.Base").Activate ' <<< il foglio dove preleva
Range("c9:c1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("m7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
Range("m7").Select ' la cella dove incollare i dati
masopen = ckf("masa1.xls") 'True=file gia' aperto
percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & Nfile
Worksheets("1-masa1-Fogl.Base").Activate ' <<< il foglio dal quale preleva
Range("l9:l1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("n7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
Range("n7").Select ' la cella dove incollare i dati
masopen = ckf("masa1.xls") 'True=file gia' aperto
percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & Nfile
Worksheets("1-masa1-Fogl.Base").Activate ' <<< il foglio dove preleva
Range("n9:n1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("o7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
Range("o7").Select ' la cella dove incollare i dati
Columns("n:o").EntireColumn.AutoFit ' adatta la larghezza colonna al contenuto
Cells.Rows.AutoFit
Columns("p:p").ColumnWidth = 3
ActiveWindow.DisplayGridlines = False
Range("m65536").End(xlUp).Offset(1, 0).Select ' vai alla prima cella libera di col u
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _
:=True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub prel1()
Dim masopen As Boolean, SecWb As String
'
SecWb = "masa1.xls"
ActiveSheet.Unprotect
masopen = ckf(SecWb) 'True=file gia' aperto
'
Application.ScreenUpdating = False
Application.Calculation = xlManual
'
percorso = Application.ActiveWorkbook.Path
'Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & "\" & SecWb
Worksheets("1-masa1-Fogl.Base").Range("c9:c1000").Copy ' <<< il foglio dove preleva
'Range("c9:c1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("m7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Application.CutCopyMode = False '<<< toglie avviso di molti dati
'If masopen = False Then ActiveWorkbook.Close savechanges:=False
'ThisWorkbook.Activate
'Sheets("giornaliero").Select
'Range("m7").Select ' la cella dove incollare i dati
'masopen = ckf("masa1.xls") 'True=file gia' aperto
'percorso = Application.ActiveWorkbook.Path
'Nfile = "\" & "masa1.xls"
'If masopen = False Then Application.Workbooks.Open percorso & Nfile
Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("l9:l1000").Copy ' <<< il foglio dal quale preleva
'Range("l9:l1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("n7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Application.CutCopyMode = False '<<< toglie avviso di molti dati
'If masopen = False Then ActiveWorkbook.Close savechanges:=False
'ThisWorkbook.Activate
'Sheets("giornaliero").Select
'Range("n7").Select ' la cella dove incollare i dati
'masopen = ckf("masa1.xls") 'True=file gia' aperto
'percorso = Application.ActiveWorkbook.Path
'Nfile = "\" & "masa1.xls"
'If masopen = False Then Application.Workbooks.Open percorso & SecWb
Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("n9:n1000").Copy ' <<< il foglio dove preleva
'Range("n9:n1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("o7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
'Range("o7").Select ' la cella dove incollare i dati
Columns("n:o").EntireColumn.AutoFit ' adatta la larghezza colonna al contenuto
Cells.Rows.AutoFit
Columns("p:p").ColumnWidth = 3
ActiveWindow.DisplayGridlines = False
Range("m65536").End(xlUp).Offset(1, 0).Select ' vai alla prima cella libera di col u
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _
:=True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub prel1()
Dim masopen As Boolean, SecWb As String
Inizio = Timer
SecWb = "masa1.xls"
ActiveSheet.Unprotect
masopen = ckf(SecWb) 'True=file gia' aperto
'
Application.ScreenUpdating = False
Application.Calculation = xlManual
'
percorso = Application.ActiveWorkbook.Path
If masopen = False Then Application.Workbooks.Open percorso & "\" & SecWb
Worksheets("1-masa1-Fogl.Base").Range("c9:c1000").Copy ' <<< il foglio dove preleva
ThisWorkbook.Sheets("giornaliero").Range("m7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("l9:l1000").Copy ' <<< il foglio preleva
ThisWorkbook.Sheets("giornaliero").Range("n7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("n9:n1000").Copy ' <<< il foglio dove preleva
ThisWorkbook.Sheets("giornaliero").Range("o7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
Columns("n:o").EntireColumn.AutoFit ' adatta la larghezza colonna al contenuto
Cells.Rows.AutoFit
Columns("p:p").ColumnWidth = 3
ActiveWindow.DisplayGridlines = False
Range("m65536").End(xlUp).Offset(1, 0).Select ' vai alla prima cella libera di col u
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _
:=True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Fine = Timer
MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")
End Sub
Torna a Applicazioni Office Windows
cerca il più grande numero di celle vuote in un intervallo Autore: papiriof |
Forum: Applicazioni Office Windows Risposte: 2 |
prelevare dati solo da URL multipli Autore: Gianca532011 |
Forum: Applicazioni Office Windows Risposte: 9 |
Prelevare dati da pagine web usando i Driver Selenium Autore: Anthony47 |
Forum: Applicazioni Office Windows Risposte: 2 |
cercare e prelevare 128 estraz del lotto Autore: raimea |
Forum: Applicazioni Office Windows Risposte: 6 |
Visitano il forum: raimea e 14 ospiti