I have a master sheet (CMRDETAILS) im taking specific data from certain columns of two other sheets (HistoricalData)(ImportData) and copying it across into the master sheet
Im trying and failing to find the loop to find the last empty cell and enter the data into that row and the empty ones that follow it, the first set of data i move is historical, then copy and paste from Importdata
Is there anyway once knowing the range to set the pasting range to utalise the count?
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim filter As String
Dim targetWorkbook As Workbook, wb As Workbook
Dim Ret As Variant
Dim Caption As String
Dim LR2 As Long
Dim LR1 As Long
Dim LastCell As Range
Dim LastCellColRef As Long
Worksheets("ImportData").Cells.Clear
Set targetWorkbook = Application.ActiveWorkbook
filter = "Text files (*.CSV),*.CSV"
Caption = "Please Select an input file "
Ret = Application.GetOpenFilename(filter, , Caption)
If Ret = False Then Exit Sub
Set wb = Workbooks.Open(Ret)
wb.Sheets(1).UsedRange.Copy targetWorkbook.Worksheets("ImportData").Range("A1")
wb.Close SaveChanges:=False
Set ws = ThisWorkbook.Sheets("ImportData")
Worksheets("ImportData").Range("D:D").EntireColumn.Insert Shift:=xlToRight
Worksheets("ImportData").Range("D1").Value = "Month"
LR1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
LR2 = ws.Range("D" & ws.Rows.Count).End(xlUp).Row + 1
ws.Range("D" & LR2 & ":D" & LR1).FormulaR1C1 = "=TEXT(R[0]C[-1], ""mmm"")"
Sheets("HistoricalData").Range("AE2:AE51").Copy Sheets("CmrDetails").Range("B2:B51")
Sheets("HistoricalData").Range("D2:D51").Copy
Sheets("CmrDetails").Range("A2:A51").PasteSpecial xlPasteValues
Sheets("HistoricalData").Range("Z2:Z51").Copy Sheets("CmrDetails").Range("c2:c51")
LastCellColRef = 1 'column number to look in when finding last cell
Set LastCell = Sheets("CmrDetails").Cells(Rows.Count, LastCellColRef).End(xlUp).Offset(1, 0)
MsgBox LastCell.Address 'just to verify the count is working
Sheets("ImportData").Range("X2:X350").Copy Sheets("CmrDetails").Range("B52:B350") 'this is the data is want to copy to the empty row
Sheets("ImportData").Range("D2:D51").Copy 'this is the data is want to copy to the empty row
Sheets("CmrDetails").Range("A52:A350").PasteSpecial xlPasteValues 'this is the data is want to copy to the empty row
Sheets("ImportData").Range("AX2:AX350").Copy Sheets("CmrDetails").Range("c52:c350") 'this is the data is want to copy to the empty row
Application.CutCopyMode = False
Sheets("CmrDetails").Range("C2:C350").EntireColumn.Hidden = True
Set ws = ThisWorkbook.Sheets("NPS")
Set LastCell = Nothing
MsgBox ("Upload Complete")
End Sub
no errors I just cant figure out the logic
A Quick Fix
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim iws As Worksheet: Set iws = wb.Sheets("ImportData")
Dim dws As Worksheet: Set dws = wb.Sheets("CmrDetails")
Dim irg As Range: Set irg = iws.Rows("2:350")
Dim drg As Range: Set drg = dws.Cells(dws.Rows.Count, "A").End(xlUp) _
.Offset(1).EntireRow.Resize(irg.Rows.Count)
iws.Columns("X").Copy Destination:=dws.Columns("B")
dws.Columns("A").Value = iws.Columns("D").Value ' only values
iws.Columns("AX").Copy Destination:=dws.Columns("C")
An Improvement
Private Sub CommandButton1_Click()
ImportCsvData
End Sub
Sub ImportCsvData()
Const PROC_TITLE As String = "Import CSV Data"
' Define constants.
Const SRC_FILE_FILTER As String = "Text files (*.CSV),*.CSV"
Const SRC_DIALOG_TITLE As String = "Source File Selection"
Const INP_SHEET_NAME As String = "ImportData"
Const INP_FIRST_CELL As String = "A1"
Const INP_INSERT_COLUMN As String = "D"
Const INP_INSERT_COLUMN_FORMULAR1C1 As String = "=TEXT(R[0]C[-1], ""mmm"")"
Const COPY_SHEET_NAME As String = "HistoricalData"
Const DST_SHEET_NAME As String = "CmrDetails"
Const DST_LAST_ROW_COLUMN As String = "A"
Const FIRST_ROWS As String = "2:51" ' 50 rows
Const SECOND_ROWS As String = "52:350" ' 349 rows, maybe "52:351"?
' Destination
' Reference the destination workbook.
Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
' Reference the Input sheet and clear it.
Dim iws As Worksheet: Set iws = dwb.Sheets(INP_SHEET_NAME)
iws.UsedRange.Clear
' Let the user select a file.
Dim sFilePath As Variant: sFilePath = Application.GetOpenFilename( _
FileFilter:=SRC_FILE_FILTER, Title:=SRC_DIALOG_TITLE)
If sFilePath = False Then
MsgBox "No file selected!", vbExclamation, PROC_TITLE
Exit Sub
End If
Application.ScreenUpdating = False
' Copy data from the Source sheet to the Input sheet.
Dim swb As Workbook: Set swb = Workbooks.Open( _
Filename:=sFilePath) ' if necessary, try with 'Local:=True'
Dim ifCell As Range: Set ifCell = iws.Range(INP_FIRST_CELL)
swb.Sheets(1).UsedRange.Copy ifCell
swb.Close SaveChanges:=False
' Destination
' Insert the specified column and populate it with the header
' and formulas from the 2nd to the last row.
iws.Columns(INP_INSERT_COLUMN).EntireColumn.Insert Shift:=xlToRight
With ifCell
Dim iLR As Long:
iLR = iws.Cells(iws.Rows.Count, .Column).End(xlUp).Row
With .EntireRow.Columns(INP_INSERT_COLUMN)
.Value = "Month" ' write header
.Offset(1).Resize(iLR - 1) _
.FormulaR1C1 = INP_INSERT_COLUMN_FORMULAR1C1 ' write formulas
End With
End With
' Reference the Copy and Destination sheets.
Dim cws As Worksheet: Set cws = dwb.Sheets(COPY_SHEET_NAME)
Dim dws As Worksheet: Set dws = dwb.Sheets(DST_SHEET_NAME)
' Reference the first entire row ranges (the same rows).
Dim crg As Range: Set crg = cws.Rows(FIRST_ROWS)
Dim drg As Range: Set drg = dws.Rows(FIRST_ROWS)
' Copy the first ranges (Copy to Destination).
crg.Columns("AE").Copy Destination:=drg.Columns("B")
drg.Columns("A").Value = crg.Columns("D").Value ' only values
crg.Columns("Z").Copy Destination:=drg.Columns("C")
' Reference the second entire row ranges.
Dim irg As Range: Set irg = iws.Rows(SECOND_ROWS)
Set drg = dws.Cells(dws.Rows.Count, _
DST_LAST_ROW_COLUMN).End(xlUp).Offset(1, 0) _
.EntireRow.Resize(irg.Rows.Count)
' Copy the second ranges (Input to 'first available' row in Destination).
irg.Columns("X").Copy Destination:=drg.Columns("B")
drg.Columns("A").Value = irg.Columns("D").Value ' only values
irg.Columns("AX").Copy Destination:=drg.Columns("C")
' Hide column 'C' in Destination.
dws.Columns("C").Hidden = True
Application.ScreenUpdating = True
' Inform.
MsgBox "Import complete.", vbInformation, PROC_TITLE
End Sub