Ciao forum,
ho una necessità.
Dovrei creare una macro che permetta di spostare il contenuto della cella A1 del Foglio1 nella prima cella libera della colonna A1 del Foglio2.
Mi potete aiutare?
Grazie
Moderatori: Anthony47, Flash30005
Private Sub CommandButton1_Click()
Dim iRow As Long
iRow = 1
While Sheets(2).Cells(iRow, 1) <> ""
iRow = iRow + 1
Wend
Sheets(2).Cells(iRow, 1).Value = Sheets(1).Cells(1, 1).Value
Sheets(1).Cells(1, 1).Value = ""
End Sub
Sub Copia()
UR = Sheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Foglio2").Range("A" & UR) = Sheets("Foglio1").Range("A1")
End Sub
Sub Sposta()
Sheets("Foglio1").Range("A1").Cut
Sheets("Foglio2").Select
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
ActiveSheet.Paste
End Sub
ricky53 ha scritto:A) Nel tuo file la convalida per scegliere l'agenzia non è impostata! Non è possibile scegliere le agenzie ma solo scriverle !!!
B) Non mi torna il calcolo che viene fatto nella cella "B11"
Domanda: la cella "C9" che funzione ha?
Private Sub CommandButton1_Click()
Call Inserisci_Dati
End Sub
Sub Inserisci_Dati()
Dim WS1 As Worksheet, WS2 As Worksheet, UR As Long, Agenzia As String
Set WS1 = Sheets("Foglio1")
Set WS2 = Sheets("Foglio2")
If WS1.Cells(1, 2) = "" Then
MsgBox "Inserire l'agenzia"
Exit Sub
End If
If WS1.Cells(2, 2) = "" Or WS1.Cells(3, 2) = "" Or WS1.Cells(4, 2) = "" Then
MsgBox "Inserire le date"
Exit Sub
End If
If WS1.Cells(8, 2) = "" Or WS1.Cells(8, 2) <= 0 Then
MsgBox "Inserire l'importo"
Exit Sub
End If
UR = WS2.Range("A" & Rows.Count).End(xlUp).Row + 1
WS2.Cells(UR, 1) = WS1.Cells(1, 2)
WS2.Cells(UR, 2) = WS1.Cells(2, 2)
WS2.Cells(UR, 3) = WS1.Cells(3, 2)
WS2.Cells(UR, 4) = WS1.Cells(4, 2)
WS2.Cells(UR, 5) = WS1.Cells(5, 2)
WS2.Cells(UR, 6) = WS1.Cells(6, 2)
WS2.Cells(UR, 7) = WS1.Cells(7, 2)
WS2.Cells(UR, 8) = WS1.Cells(8, 2)
WS2.Cells(UR, 9) = WS1.Cells(9, 2)
If WS1.Cells(10, 2) = True Then
WS2.Cells(UR, 10) = "SI"
Else
WS2.Cells(UR, 10) = "NO"
End If
WS2.Cells(UR, 11) = WS1.Cells(11, 2)
WS1.Range("B1") = ""
WS1.Range("B2:B4").ClearContents
WS1.Range("B5") = ""
WS1.Range("B6") = ""
WS1.Range("B7") = ""
WS1.Range("B8") = 0
WS1.Range("B10") = False
Agenzia = WS2.Cells(UR, 1)
MsgBox "Copia dei dati per l'agenzia '" & Agenzia & "' correttamente effettuata"
End Sub
Public Riga2 As Integer
Sub ModificaElimina()
Ag = [B1]
Tr = 0
'Worksheets("Foglio2").Visible = True
UR2 = Worksheets("Foglio2").Range("F" & Rows.Count).End(xlUp).Row
For RR2 = 2 To UR2
If Ag = Worksheets("Foglio2").Range("F" & RR2).Value Then
Riga2 = RR2
Tr = 1
Exit For
End If
Next RR2
If Tr = 1 Then
[B2] = Worksheets("Foglio2").Range("B" & RR2).Value
[B3] = Worksheets("Foglio2").Range("C" & RR2).Value
[B4] = Worksheets("Foglio2").Range("D" & RR2).Value
[B5] = Worksheets("Foglio2").Range("E" & RR2).Value
[B6] = Worksheets("Foglio2").Range("A" & RR2).Value
[B7] = Worksheets("Foglio2").Range("G" & RR2).Value
[B8] = Worksheets("Foglio2").Range("H" & RR2).Value
If Worksheets("Foglio2").Range("J" & RR2).Value = "SI" Then
[B10] = 1
Else
[B10] = 0
End If
[B11] = Worksheets("Foglio2").Range("K" & RR2).Value
End If
End Sub
Sub Modifica()
Worksheets("Foglio2").Range("B" & Riga2).Value = [B2]
Worksheets("Foglio2").Range("C" & Riga2).Value = [B3]
Worksheets("Foglio2").Range("D" & Riga2).Value = [B4]
Worksheets("Foglio2").Range("E" & Riga2).Value = [B5]
Worksheets("Foglio2").Range("A" & Riga2).Value = [B6]
Worksheets("Foglio2").Range("G" & Riga2).Value = [B7]
Worksheets("Foglio2").Range("H" & Riga2).Value = [B8]
End Sub
Sub Elimina()
Ag = [B1]
Worksheets("Foglio2").Rows(Riga2).Delete
Range("B1") = ""
Range("B2:B4").ClearContents
Range("B5") = ""
Range("B6") = ""
Range("B7") = ""
Range("B8") = 0
Range("B10") = False
Range("C9") = ""
Range("B11") = ""
MsgBox Ag & " Eliminata"
End Sub
Torna a Applicazioni Office Windows
Elimina righe "precedenti" un determinato valore Autore: marcopont |
Forum: Applicazioni Office Windows Risposte: 4 |
Macro che rinomina, sposta e chiude un file excel Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 16 |
Collegamento che punta a una qualunque fine colonna Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: giorgioa e 45 ospiti