Aug 19 2022 12:50 AM
Hi
1. I have previously managed to copy and paste cells from one worksheet (named: Form) to another Worksheet (selected in Cell C4). I have managed to get it to copy the column into a row on the correct sheet, but I can't get it to go to the next available line.
2. I also want it to go to another tab, where all the data will be stored (in the same workbook, tab = "Data")
3. If one of the Cells (C28) = a specific word I want the data to also be copy and pasted into the tab i.e "B"
Any help would be much appreciated
Sub Copy_Data()
Dim hh As Worksheet, exist As Boolean, h As Worksheet, sh As Worksheet
Dim f As Range
Set hh = Sheets("Form")
If hh.Range("C4") = "" Then
MsgBox "Enter Hospital", vbCritical
Exit Sub
End If
If hh.Range("C5") = "" Then
MsgBox "Enter Ward", vbCritical
Exit Sub
End If
exist = False
For Each h In Sheets
If LCase(h.Name) = LCase(hh.Range("C4").Value) Then
Set sh = h
exist = True
Exit For
End If
Next
If exist = False Then
MsgBox "The sheet does not exist", vbCritical
Exit Sub
End If
Set f = sh.Range("A1").Find(hh.Range("C4").Value, , xlValues, xlWhole)
If f Is Nothing Then
MsgBox "This does not exist", vbCritical
Else
'Copy data to Site Sheet'
'cell destination cell origin
sh.Cells(Rows.Count, 1, "A:T").Value = hh.Range("C5:C23").Value
End If
End Sub
Aug 19 2022 03:19 AM
Please test on a copy of your workbook:
Sub Copy_Data()
Dim hh As Worksheet
Dim sh As Worksheet
Dim r As Long
Dim f As Range
Set hh = Sheets("Form")
If hh.Range("C4") = "" Then
MsgBox "Enter Hospital", vbCritical
Exit Sub
End If
If hh.Range("C5") = "" Then
MsgBox "Enter Ward", vbCritical
Exit Sub
End If
On Error Resume Next
Set sh = Sheets(CStr(hh.Range("C4").Value))
On Error GoTo 0
If sh Is Nothing Then
MsgBox "The sheet does not exist", vbCritical
Exit Sub
End If
Set f = sh.Range("A1").Find(hh.Range("C4").Value, , xlValues, xlWhole)
If f Is Nothing Then
MsgBox "This does not exist", vbCritical
Else
'Copy data to Site Sheet
r = sh.UsedRange.Rows.Count + 1
'cell destination cell origin
sh.Range("A" & r).Resize(1, 19).Value = Application.Transpose(hh.Range("C5:C23").Value)
End If
Set sh = Sheets("Data")
r = sh.UsedRange.Rows.Count + 1
'cell destination cell origin
sh.Range("A" & r).Resize(1, 19).Value = Application.Transpose(hh.Range("C5:C23").Value)
If hh.Range("C28") = "a specific word" Then
Set sh = Sheets("B")
r = sh.UsedRange.Rows.Count + 1
'cell destination cell origin
sh.Range("A" & r).Resize(1, 19).Value = Application.Transpose(hh.Range("C5:C23").Value)
End If
End Sub
Aug 19 2022 03:31 AM
Aug 19 2022 05:54 AM
The code works in a simple demo (attached). Do the ranges that you refer to contain merged cells?
Aug 19 2022 06:09 AM