Moderatori: Anthony47, Flash30005
Sub DayStor()
Dim DaySh As Worksheet, StoreSh As Worksheet, DateCol As String, StorCol As String
Dim I As Long, myMatch
'
'I dati:
Set DaySh = ThisWorkbook.Sheets("Giornaliero") '<<< Il foglio Giornaliero
Set StoreSh = ThisWorkbook.Sheets("Scarico") '<<< Il foglio su cui storicizzare
DateCol = "A" '<<< La colonna dove trovo le Date
StorCol = "B" '<<< La colonna in cui copiare il valore
'
On Error Resume Next
myMatch = Application.Match(CLng(DaySh.Range("A1").Value), StoreSh.Cells(1, DateCol).Resize(1000, 1), False)
On Error GoTo 0
If IsError(myMatch) Or IsEmpty(myMatch) Then
rispo = MsgBox("Non allocabile: " & DaySh.Range("A1").Text, 0, "ERRORE!")
Else
StoreSh.Cells(myMatch, StorCol).Value = DaySh.Range("E15")
End If
End Sub
Sub DayStor2()
Dim DaySh As Worksheet, StoreSh As Worksheet
Dim myMatchM, myMatchD, Rispo
'
'I dati:
Set DaySh = ThisWorkbook.Sheets("Giornaliero") '<<< Il foglio Giornaliero
Set StoreSh = ThisWorkbook.Sheets("Scarico") '<<< Il foglio su cui storicizzare
'
On Error Resume Next
myMatchM = Application.Match(Format(DaySh.Range("C1").Value, "mmmm"), StoreSh.Range("A1:A30"), False)
myMatchD = Application.Match(Day(DaySh.Range("C1").Value), StoreSh.Range("A1:AZ1"), False)
On Error GoTo 0
If IsError(myMatchM) Or IsError(myMatchD) Or IsEmpty(myMatchM) Or IsEmpty(myMatchD) Then
Rispo = MsgBox("Non allocabile: " & DaySh.Range("C1").Text, 0, "ERRORE!")
Else
StoreSh.Cells(myMatchM, myMatchD).Value = DaySh.Range("E16")
End If
End Sub
Sub CopiaIncollaprova()
Dim myNext As Long
If Worksheets("Giornaliero").Range("G3") = "da pagare" Then
myNext = Worksheets("da pagare").Cells(Rows.Count, 1).End(xlUp).Row 'Prima riga libera
Worksheets("da pagare").Cells(myNext, "A").Value = Worksheets("Giornaliero").Range("C1").Value
Worksheets("da pagare").Cells(myNext, "B").Resize(1, 3).Value = Worksheets("Giornaliero").Range("D3:F3").Value
End If
End Sub
Sub CopiaIncollaprova2()
Dim myNext As Long
For I = 3 To 13
If Worksheets("Giornaliero").Cells(I, "G") = "da pagare" Then
myNext = Worksheets("da pagare").Cells(Rows.Count, 1).End(xlUp).Row 'Prima riga libera
Worksheets("da pagare").Cells(myNext, "A").Value = Worksheets("Giornaliero").Range("C1").Value
Worksheets("da pagare").Cells(myNext, "B").Resize(1, 3).Value = Worksheets("Giornaliero").Cells(I, "D").Resize(1, 3).Value
End If
Next I
End Sub
myNext = Worksheets("da pagare").Cells(Rows.Count, 1).End(xlUp).Row + 1 'Prima riga libera
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: Nessuno e 46 ospiti