Problem searching, copying and pasting between sheets

[Torben_fred]

Hi.

I am working on a programme I can use to plan status in shops. I have created 2 userforms. The first one is for adding shops to the database sheet. The database sheet contains all information of the respective shops. This userform works fine.

The second userform is for planning status. I must be able to fill in the dates, shopnumber etc. into the the userform and the data must be written to the output sheet. That part works fine.
When I enter the shopnumber, I will like to copy the data of the shop I need (columns B to H) into the output sheet (columns D to J).This part causes me a lot of trouble

What I have done:
- I have used a boolean loop to find the shopnumber I enter into my userform in the database sheet. This works fine.
- To copy the aforementioned data on the shop, I found a code to copy the row and paste it into a new sheet “hidden”.

The problem is every time I plan a new status, it writes into the same row in both the “hidden” and the output sheet instead of writing in the row.

I guess I must make some kind of loop, but I do not know how to specify it. I am new to VBA programming.

I hope someone will help me solve this problem

My complete code is as follows:

Private Sub CommandButton1_Click()
'Plan status
Worksheets("output").Activate
Dim r As Integer

'Find first empty row
r = Range("A1").CurrentRegion.Rows.Count + 1

'Write headlines
Range("A1").Value = "Uge"
Range("B1").Value = "Dato"
Range("C1").Value = "Butiksnr"
Range("D1").Value = "Adresse"
Range("E1").Value = "PostNr"
Range("F1").Value = "By"
Range("g1").Value = "Afstand fra Aarhus"
Range("h1").Value = "Køretid"
Range("i1").Value = "Afgang fra Aarhus"
Range("j1").Value = "Forventet Hjemkomst"
Range("k1").Value = "Chauffør 1"
Range("l1").Value = "Chauffør 2"


'Check form
If TextBox1.Value = "" Then
MsgBox "Indtast Ugenummer.", vbCritical, "Manglende data"
TextBox1.SetFocus
Exit Sub
End If


If TextBox1.Value >= 54 Then
MsgBox "Indtast det korrekte ugenummer!", vbCritical, "Ugyldig indtastning"
TextBox1.SetFocus
Exit Sub
End If


If TextBox2.Value = "" Then
MsgBox "Indtast dato.", vbCritical, "Manglende data"
TextBox2.SetFocus
Exit Sub
End If


If TextBox3.Value = "" Then
MsgBox "Indtast butiksnummer.", vbCritical, "Manglende data"
TextBox3.SetFocus
Exit Sub
End If


If TextBox4.Value = "" Then
MsgBox "Indtast chauffør.", vbCritical, "Manglende data"
TextBox4.SetFocus
Exit Sub
End If


If TextBox5.Value = "" Then
MsgBox "Indtast chauffør.", vbCritical, "Manglende data"
TextBox5.SetFocus
Exit Sub
End If


'Write data directly to output sheet
Range("A" & r).Value = TextBox1.Value
Range("B" & r).Value = TextBox2.Value
Range("C" & r).Value = TextBox3.Value
Range("K" & r).Value = TextBox4.Value
Range("L" & r).Value = TextBox5.Value




'Sub FindAndCopy()
Worksheets("Database").Activate
numberofshops = WorksheetFunction.Count(Range("A1:A65536"))


Dim i As Integer
Dim ShopNumber As Integer
Dim found As Boolean


ShopNumber = TextBox3.Value


'Write headers to hidden sheet
Worksheets("Hidden").Range("A1").Value = "Butiksnummer"
Worksheets("Hidden").Range("B1").Value = "Adresse"
Worksheets("Hidden").Range("C1").Value = "Post nummer"
Worksheets("Hidden").Range("D1").Value = "By"
Worksheets("Hidden").Range("E1").Value = "Afstand fra Aarhus"
Worksheets("Hidden").Range("F1").Value = "Køretid"
Worksheets("Hidden").Range("G1").Value = "Afgang fra Aarhus"
Worksheets("Hidden").Range("H1").Value = "Forventet hjemkomst"
Worksheets("Hidden").Range("I1").Value = "Distrikt"
Worksheets("Hidden").Range("J1").Value = "IP adresse"


found = False
For i = 2 To numberofshops
If (Cells(i, 1).Value = ShopNumber) Then
found = True
End If
Next
If found = True Then




Dim x As Integer


x = Worksheets("hidden").Range("A1").CurrentRegion.Rows.Count + 1


Worksheets("Hidden").Range("A1").Value = "Butiksnummer" 'Shopnumber
Worksheets("Hidden").Range("B1").Value = "Adresse"
Worksheets("Hidden").Range("C1").Value = "Post nummer"
Worksheets("Hidden").Range("D1").Value = "By" 'city
Worksheets("Hidden").Range("E1").Value = "Afstand fra Aarhus" 'distance from Aarhus
Worksheets("Hidden").Range("F1").Value = "Køretid" 'Driving time
Worksheets("Hidden").Range("G1").Value = "Afgang fra Aarhus" 'Departure from Aarhus
Worksheets("Hidden").Range("H1").Value = "Forventet hjemkomst" 'Estimated arrival in Aarhus
Worksheets("Hidden").Range("I1").Value = "Distrikt"
Worksheets("Hidden").Range("J1").Value = "IP adresse"




Dim lRow As Long

lRow = Columns("A").Find(ShopNumber, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Row
Range("A" & lRow & ":AR" & lRow).Copy Destination:=Worksheets("Hidden").Range("A2:J" & x)


MsgBox ("Status er planlagt."), vbOKOnly, "Status er tilføjet."
Else


MsgBox "Butikken skal oprettes i databasen.", vbCritical, "Butikken er ikke oprettet!"


'Deletes the row from output sheet if the store does not exist
Dim ws As Worksheet
Dim Rand As Long
Set ws = Worksheets("Output")
ws.Rows(r).Delete


End If


Worksheets("Output").Range("D2").Value = Worksheets("hidden").Range("B2")
Worksheets("Output").Range("E2").Value = Worksheets("hidden").Range("C2")
Worksheets("Output").Range("F2").Value = Worksheets("hidden").Range("D2")
Worksheets("Output").Range("G2").Value = Worksheets("hidden").Range("E2")
Worksheets("Output").Range("H2").Value = Worksheets("hidden").Range("F2")
Worksheets("Output").Range("I2").Value = Worksheets("hidden").Range("G2")
Worksheets("Output").Range("J2").Value = Worksheets("hidden").Range("H2")


End Sub