Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
Copiare solo celle piene
784 views
Skip to first unread message
pino
Mar 12, 2012, 9:04:27 AM3/12/12
to
Ho un foglio PINO composto da tre colonne e che preleva i dati dalla
cartella PIPPO (cartella non aperta) con le istruzioni
“=…[Pippo.xls].Foglio!$a$1 e così via per tutte le celle del foglio.
Ora con “Range(Range("a2:c2").Address & ":" &
Range("a2:c2").End(xlDown).Address).Select” dovrei selezionare solo le
celle che contengono dati mentre, in realtà, l’istruzione mi seleziona
tutte le celle che pur non avendo dati contengono ovviamente il
riferimento al foglio Pippo.
Infatti non potendo predeterminare quante righe ci sono o ci saranno
nel foglio PIPPO nel mio foglio PINO ho inserito in tantissime righe i
riferimenti alle rispettive celle del foglio PIPPO.
Ora per altre operazioni che devo fare è importante che siano prelevate
solo le righe che hanno effettivamente dei dati.
Come si può ovviare.
Grazie per l’aiuto.
cartella PIPPO (cartella non aperta) con le istruzioni
“=…[Pippo.xls].Foglio!$a$1 e così via per tutte le celle del foglio.
Ora con “Range(Range("a2:c2").Address & ":" &
Range("a2:c2").End(xlDown).Address).Select” dovrei selezionare solo le
celle che contengono dati mentre, in realtà, l’istruzione mi seleziona
tutte le celle che pur non avendo dati contengono ovviamente il
riferimento al foglio Pippo.
Infatti non potendo predeterminare quante righe ci sono o ci saranno
nel foglio PIPPO nel mio foglio PINO ho inserito in tantissime righe i
riferimenti alle rispettive celle del foglio PIPPO.
Ora per altre operazioni che devo fare è importante che siano prelevate
solo le righe che hanno effettivamente dei dati.
Come si può ovviare.
Grazie per l’aiuto.
Bruno Campanini
Mar 12, 2012, 1:19:57 PM3/12/12
to
pino explained on 12-03-12 :
Copia i dati da Pippo a Pino usando quattro righe di codice VBA,
evitando così di spargere formule laddove ancora non vi sono dati.
Bruno
evitando così di spargere formule laddove ancora non vi sono dati.
Bruno
pino
Mar 12, 2012, 3:34:07 PM3/12/12
to
Scriveva Bruno Campanini lunedì, 12/03/2012:
imprecisato di righe, mi daresti un esempio di queste "quattro righe di
codice VBA"?
Grazie
> Copia i dati da Pippo a Pino usando quattro righe di codice VBA, evitando
> così di spargere formule laddove ancora non vi sono dati.
>
> Bruno
Considerando che il foglio Pippo è fatto di tre colonne e di un numero
> così di spargere formule laddove ancora non vi sono dati.
>
> Bruno
imprecisato di righe, mi daresti un esempio di queste "quattro righe di
codice VBA"?
Grazie
Bruno Campanini
Mar 12, 2012, 9:12:15 PM3/12/12
to
pino wrote on 12-03-12 :
Beh, quattro righe è un modo di dire... per dir che non son tante.
=====================================
Sub Button1_Click()
Dim SourceFile As String, SheetName_Source As String, SheetName_Target
As String
Dim StartCell_Source As String, StartCell_Target As String
Dim i As Integer, k As Long, j As Range, NumCol As Integer
Dim SourceRange As Range, TargetRange As Range
' -------Definizioni -----------
SourceFile = "Pippo.xlsx"
SheetName_Source = "Sheet1"
StartCell_Source = "A1"
SheetName_Target = "Riepilogo"
StartCell_Target = "C3"
NumCol = 3
' ------------------------------
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Workbooks.Open ThisWorkbook.Path & "\" & SourceFile
Set SourceRange =
Workbooks(SourceFile).Sheets(SheetName_Source).Range(StartCell_Source)
If Not IsEmpty(SourceRange(2, 1)) Then
Set SourceRange = SourceRange.Resize _
(SourceRange.End(xlDown).Row - SourceRange.Row + 1)
End If
Set TargetRange =
ThisWorkbook.Sheets(SheetName_Target).Range(StartCell_Target)
If Not IsEmpty(TargetRange(2, 1)) Then
Set TargetRange = TargetRange.Resize _
(TargetRange.End(xlDown).Row - TargetRange.Row + 1)
End If
Do
k = k + 1
If IsEmpty(TargetRange(k, 1)) Then
Exit Do
End If
Loop
For Each j In SourceRange
For i = 1 To NumCol
TargetRange(k, i) = j(, i)
Next
k = k + 1
Next
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
===============================================
Bruno
=====================================
Sub Button1_Click()
Dim SourceFile As String, SheetName_Source As String, SheetName_Target
As String
Dim StartCell_Source As String, StartCell_Target As String
Dim i As Integer, k As Long, j As Range, NumCol As Integer
Dim SourceRange As Range, TargetRange As Range
' -------Definizioni -----------
SourceFile = "Pippo.xlsx"
SheetName_Source = "Sheet1"
StartCell_Source = "A1"
SheetName_Target = "Riepilogo"
StartCell_Target = "C3"
NumCol = 3
' ------------------------------
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Workbooks.Open ThisWorkbook.Path & "\" & SourceFile
Set SourceRange =
Workbooks(SourceFile).Sheets(SheetName_Source).Range(StartCell_Source)
If Not IsEmpty(SourceRange(2, 1)) Then
Set SourceRange = SourceRange.Resize _
(SourceRange.End(xlDown).Row - SourceRange.Row + 1)
End If
Set TargetRange =
ThisWorkbook.Sheets(SheetName_Target).Range(StartCell_Target)
If Not IsEmpty(TargetRange(2, 1)) Then
Set TargetRange = TargetRange.Resize _
(TargetRange.End(xlDown).Row - TargetRange.Row + 1)
End If
Do
k = k + 1
If IsEmpty(TargetRange(k, 1)) Then
Exit Do
End If
Loop
For Each j In SourceRange
For i = 1 To NumCol
TargetRange(k, i) = j(, i)
Next
k = k + 1
Next
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
===============================================
Bruno
pino
Mar 13, 2012, 3:55:11 AM3/13/12
to
Nel suo scritto precedente, Bruno Campanini ha sostenuto :
Lo provo subito.
Pino
> Beh, quattro righe è un modo di dire... per dir che non son tante.
>
>Grazie.
>
Lo provo subito.
Pino
pino
Mar 13, 2012, 4:27:45 AM3/13/12
to
Funziona benissimo.
Ho provato ad aumentare le colonne dei dati modificando la variabile
"NumCol" ma sono sempre preleati i dati delle prime tre colonne.
Cosa devo anche cambiare.
Grazie
Pino
Ho provato ad aumentare le colonne dei dati modificando la variabile
"NumCol" ma sono sempre preleati i dati delle prime tre colonne.
Cosa devo anche cambiare.
Grazie
Pino
Bruno Campanini
Mar 13, 2012, 9:12:55 AM3/13/12
to
pino used his keyboard to write :
Devi solo modificare NumCol e... avere dati in colonna 4 del file
sorgente.
sorgente.
eliano
Mar 13, 2012, 9:23:03 AM3/13/12
to
pino
Mar 13, 2012, 11:01:37 AM3/13/12
to
> Devi solo modificare NumCol e... avere dati in colonna 4 del file sorgente.
Tutto Ok.
Chiedo scusa, avevo modificato il valore di NumCol ma poi non ho
salvato la modifica e, naturalmente, quando ho avviato nuovamente il
file non è successo niente.
Grazie.
pino
Mar 14, 2012, 4:23:10 AM3/14/12
to
Visto che avete risolto il mio problema, spero di non abusare della
vostra cortesia e competenza avanzando una nuova richiesta.
Come fare se con la stessa macro volessi copiare i dati di più fogli?
Mi spiego meglio: le cartelle sorgenti, composte da un unico foglio,
possono essere piu di una (fino a dieci) e nella cartella di riepilogo
ci sono tanti fogli, quante sono le cartelle sorgenti.
Come prova ho inserito all'inizio della macro questo ciclo:
for xy=1 to 3
if xy = 1 then
SourceFile = "Alto.xls"
SheetName_Target = "Alto"
end if
if xy= 2 then
SourceFile = "Basso.xls"
SheetName_Target = "Basso"
End if
così via per tutti gli altri fogli
Ho posto l'istruzione NEXT xy prima di END SUB ma vengono copiati solo
i dati del primo foglio mentre gli altri restano vuoti.
Potete darmi un'ultimo aiuto.
Grazie
Pino
vostra cortesia e competenza avanzando una nuova richiesta.
Come fare se con la stessa macro volessi copiare i dati di più fogli?
Mi spiego meglio: le cartelle sorgenti, composte da un unico foglio,
possono essere piu di una (fino a dieci) e nella cartella di riepilogo
ci sono tanti fogli, quante sono le cartelle sorgenti.
Come prova ho inserito all'inizio della macro questo ciclo:
for xy=1 to 3
if xy = 1 then
SourceFile = "Alto.xls"
SheetName_Target = "Alto"
end if
if xy= 2 then
SourceFile = "Basso.xls"
SheetName_Target = "Basso"
End if
così via per tutti gli altri fogli
Ho posto l'istruzione NEXT xy prima di END SUB ma vengono copiati solo
i dati del primo foglio mentre gli altri restano vuoti.
Potete darmi un'ultimo aiuto.
Grazie
Pino
Bruno Campanini
Mar 14, 2012, 1:52:50 PM3/14/12
to
pino formulated the question :
> Visto che avete risolto il mio problema, spero di non abusare della vostra
> cortesia e competenza avanzando una nuova richiesta.
[...]
Lo sapevo che l'appetito vien mangiando...
=============================================
Sub Button1_Click()
'
' Excel 2010 13-03-2012
'
' Raggruppa e somma in Riepilogo.xlsm, Sheet: SheetName_Target()
' i dati che si trovano nei file: SheetName_Target() & ".xlsx"
' nel fogli SheetName_Source
'
Dim SheetName_Source As String, SheetName_Target() As String
' -------Definizioni -----------
SheetNum = 5
ReDim SheetName_Target(1 To SheetNum)
SheetName_Target(1) = "File_1"
SheetName_Target(2) = "File_2"
SheetName_Target(3) = "File_3"
SheetName_Target(4) = "File_4"
SheetName_Target(5) = "File_5"
StartCell_Target = "C3"
SheetName_Source = "Sheet1"
StartCell_Source = "A1"
NumCol = 4
Workbooks.Open ThisWorkbook.Path & "\" & SheetName_Target(m) &
".xlsx"
Set SourceRange = Workbooks(SheetName_Target(m) &
".xlsx").Sheets(SheetName_Source).Range(StartCell_Source)
StartCell_Target-->Down.
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
==============================================
Bruno
> Visto che avete risolto il mio problema, spero di non abusare della vostra
> cortesia e competenza avanzando una nuova richiesta.
Lo sapevo che l'appetito vien mangiando...
=============================================
Sub Button1_Click()
'
' Excel 2010 13-03-2012
'
' Raggruppa e somma in Riepilogo.xlsm, Sheet: SheetName_Target()
' i dati che si trovano nei file: SheetName_Target() & ".xlsx"
' nel fogli SheetName_Source
'
Dim SheetName_Source As String, SheetName_Target() As String
Dim StartCell_Source As String, StartCell_Target As String
Dim i As Integer, k As Long, j As Range, NumCol As Integer
Dim SourceRange As Range, TargetRange As Range
Dim SheetNum As Integer, m As Integer
Dim i As Integer, k As Long, j As Range, NumCol As Integer
Dim SourceRange As Range, TargetRange As Range
' -------Definizioni -----------
SheetNum = 5
ReDim SheetName_Target(1 To SheetNum)
SheetName_Target(1) = "File_1"
SheetName_Target(2) = "File_2"
SheetName_Target(3) = "File_3"
SheetName_Target(4) = "File_4"
SheetName_Target(5) = "File_5"
StartCell_Target = "C3"
SheetName_Source = "Sheet1"
StartCell_Source = "A1"
' ------------------------------
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For m = 1 To SheetNum
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Workbooks.Open ThisWorkbook.Path & "\" & SheetName_Target(m) &
".xlsx"
Set SourceRange = Workbooks(SheetName_Target(m) &
".xlsx").Sheets(SheetName_Source).Range(StartCell_Source)
If Not IsEmpty(SourceRange(2, 1)) Then
Set SourceRange = SourceRange.Resize _
(SourceRange.End(xlDown).Row - SourceRange.Row + 1)
End If
Set TargetRange =
ThisWorkbook.Sheets(SheetName_Target(m)).Range(StartCell_Target)
Set SourceRange = SourceRange.Resize _
(SourceRange.End(xlDown).Row - SourceRange.Row + 1)
End If
Set TargetRange =
If Not IsEmpty(TargetRange(2, 1)) Then
Set TargetRange = TargetRange.Resize _
(TargetRange.End(xlDown).Row - TargetRange.Row + 1)
End If
' APPEND ad iniziare dalla prima cella vuota di
Set TargetRange = TargetRange.Resize _
(TargetRange.End(xlDown).Row - TargetRange.Row + 1)
End If
StartCell_Target-->Down.
Do
k = k + 1
If IsEmpty(TargetRange(k, 1)) Then
Exit Do
End If
Loop
For Each j In SourceRange
For i = 1 To NumCol
TargetRange(k, i) = j(, i)
Next
k = k + 1
Next
k = 0
k = k + 1
If IsEmpty(TargetRange(k, 1)) Then
Exit Do
End If
Loop
For Each j In SourceRange
For i = 1 To NumCol
TargetRange(k, i) = j(, i)
Next
k = k + 1
Next
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
==============================================
pino
Mar 14, 2012, 5:41:07 PM3/14/12
to
Bruno Campanini ha detto questo mercoledì :
Grazie
Pino
> Lo sapevo che l'appetito vien mangiando...
E' un vero piacere poter contare su persone così cortesi e competenti ma vedrò di non approfittare troppo.
Grazie
Pino
Bruno Campanini
Mar 14, 2012, 5:43:41 PM3/14/12
to
It happens that pino formulated :
Approfitta pure senza scrupoli che poi ti mando il conto...
Bruno
Bruno
pino
Mar 26, 2012, 10:29:17 AM3/26/12
to
Bruno Campanini ha pensato forte :
Riferendomi sempre alla tua macro è sorto un problema.
I file di origine dei dati sono protetti in apertura e quindi quando
avvio il prelievo dei dati mi viene chiesta la password di apertura e
vorrei, invece, che a secomnda del file di origine sia automaticamente
immessa la relativa password che io conosco perché l'ho assegnata ai
vari operatori che lavorano sui vari file di origine.
Quindi ogni volta che sia apre un file di origine la macro deve
prelevare anche la relativa password per poter copiare i dati.
Ipotizziamo di avere queste password:
File_1 = franco
File_2 = gianni
File_3 = anna
ecc.
Non so dove inserire il comando unprotect e allora mi rivolgo ancora
alla tua esperienza.
Grazie
file di origine sono 10 dieci e quindi ci sono dieci diverse password
> Approfitta pure senza scrupoli che poi ti mando il conto...
> Bruno
... sperando che il conto non sia salato ( ;-) approfitto subito.
> Bruno
Riferendomi sempre alla tua macro è sorto un problema.
I file di origine dei dati sono protetti in apertura e quindi quando
avvio il prelievo dei dati mi viene chiesta la password di apertura e
vorrei, invece, che a secomnda del file di origine sia automaticamente
immessa la relativa password che io conosco perché l'ho assegnata ai
vari operatori che lavorano sui vari file di origine.
Quindi ogni volta che sia apre un file di origine la macro deve
prelevare anche la relativa password per poter copiare i dati.
Ipotizziamo di avere queste password:
File_1 = franco
File_2 = gianni
File_3 = anna
ecc.
Non so dove inserire il comando unprotect e allora mi rivolgo ancora
alla tua esperienza.
Grazie
0 new messages