VBA Macro Copy to next empty row, different sheet
Hey guys, so I made a macro to copy data from my data entry sheet to my database sheet:
VB:
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheet2.Range("d3,d5,d7,d9,d11,d13,d15,d17,d19,d21,d23,d25,d27,d29,d33,d35").Copy
'copy to next page
Sheets("September").Select
Selection.PasteSpecial (xlValues), Transpose:=True
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Me.Hide
End Sub
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
The main to problems are that its not pasting in in the right collum and its not passing the next entry in the next free row.
Have attached a screenshot of the two sheets, at the sheet has some personal data, i won't be able to upload it.
Hope someone can help me wrap my head round this, been searching all over the web all day !
Another solution
Hi,
Here's another solution:
' ************************* ' ************************* '
Sub InsertEntryInToDataBase()
Dim oEntryWsh As Worksheet
Dim oDataBaseWsh As Worksheet
Dim sCopyRng As String
Dim sPasteColumn As String
Dim lRowN As Long
Dim oPasteRng As Range
Set oEntryWsh = Sheet1 ' Change Sheet1 to desired entry sheet
Set oDataBaseWsh = Sheet2 ' Change Sheet2 to desired DB sheet
sCopyRng = "D3, D5, D7, D9, D11, D13, D15, D17, D19, D21, D23, D25, D27, D29, D31, D33, D35"
sPasteColumn = "A" ' Change "A" to desired column
oEntryWsh.Range(sCopyRng).Copy
With oDataBaseWsh
lRowN = .Range(sPasteColumn & .Rows.Count).End(xlUp).Row + 1
Set oPasteRng = .Range(sPasteColumn & lRowN)
End With
oPasteRng.PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub
' ************************* ' ************************* '
Note: This subroutine assumes that there can be no rows with empty first cell in the database.
Best regards.
Code answer
hope this is what ur looking for :
code :
Dim i As Integer
Sub Bouton1_Cliquer()
Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Sheet2").Range("D3,D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,D25,D27,D29,D31,D33,D35").Copy
'copy to next page
Sheets("September").Select
i = 3
While Range("B" & i).Value <> ""
i = i + 1
Wend
Range("B" & i).Select
Selection.PasteSpecial (xlValues), Transpose:=True
End Sub