Forum Discussion
semiro1815
Feb 04, 2021Brass Contributor
COUNT & Copy to Last Row, Paste to another sheet to Last Row (FIRST EMPTY ROW, adding, not replacing
Hey friends. Im New in VBA. Could you help me at this? So, we have 2 columns: AB with data, in Sheet1 I want to COPY until Last Row in AB Column from Sheet1 and paste it to Sheet2, column CD in...
- Feb 04, 2021
That happens if columns C and D are empty. See if this is better:
Sub CopyData() Dim m As Long Dim r As Long m = Worksheets("Sheet1").Range("A:B").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row On Error Resume Next r = Worksheets("Sheet2").Range("C:D").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 If Err Then r = 1 End If On Error GoTo 0 Worksheets("Sheet1").Range("A1:B" & m).Copy Destination:=Worksheets("Sheet2").Range("C" & r) Application.CutCopyMode = False End Sub
HansVogelaar
Mar 03, 2021MVP
semiro1815 My apologies, I forgot one line
Sub CopySheets()
Dim strDesktop As String
Dim strFile As String
Dim wbkSource As Workbook
Dim wshSource As Worksheet
Dim wbkTarget As Workbook
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbkTarget = ActiveWorkbook
strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
strFile = Dir(strDesktop & "*.xls*")
Do While strFile <> ""
Set wbkSource = Workbooks.Open(strDesktop & strFile)
For Each wshSource In wbkSource.Worksheets
wshSource.Copy After:=wbkTarget.Worksheets(wbkTarget.Worksheets.Count)
Next wshSource
wbkSource.Close SaveChanges:=False
strFile = Dir
Loop
ExitHandler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Subsemiro1815
Mar 04, 2021Brass Contributor
Works perfect! And i was wondering, is there any way that while the macro is running, it shows up a loading percentage, for eg just like when installing a software, haha. Is this possible?
- HansVogelaarMar 04, 2021MVP
That won't work - code execution will be paused as long as a MsgBox is displayed.
I'd use the status bar for this purpose - see my previous reply.
Or a modeless userform - see Beautiful VBA Progress Bar with Step by Step Instructions
- semiro1815Mar 04, 2021Brass ContributorThank you. But not especially in this case. I mean in general, for any macro. For example i was thinking if we could add even manually through code lines a MsgBox every 3 vba lines showing a percentage 10% 20% 40% 70% 100%. And the MsgBox could update eventually. Not while pressing Ok or any button, haha.
- HansVogelaarMar 04, 2021MVP
That would be difficult, since you don't know in advance how many workbooks and how many worksheets have to be processed.
You could, however, display which sheet is being processed in the status bar:
Sub CopySheets() Dim strDesktop As String Dim strFile As String Dim wbkSource As Workbook Dim wshSource As Worksheet Dim wbkTarget As Workbook On Error GoTo ErrHandler Application.ScreenUpdating = False Application.DisplayAlerts = False Set wbkTarget = ActiveWorkbook strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" strFile = Dir(strDesktop & "*.xls*") Do While strFile <> "" Set wbkSource = Workbooks.Open(strDesktop & strFile) For Each wshSource In wbkSource.Worksheets Application.StatusBar = "Processing '" & wshSource.Name & _ "' in '" & wbkSource.Name & "'" wshSource.Copy After:=wbkTarget.Worksheets(wbkTarget.Worksheets.Count) Next wshSource wbkSource.Close SaveChanges:=False strFile = Dir Loop ExitHandler: Application.StatusBar = False Application.DisplayAlerts = True Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description, vbExclamation Resume ExitHandler End Sub