• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel 2003 VBA hulp voor "laatste regel in een sheet" en "if sheets exists"

  • Onderwerp starter Onderwerp starter ROSO
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

ROSO

Gebruiker
Lid geworden
4 nov 2009
Berichten
89
Beste forum leden,

Kan iemand mij met het volgen probleem helpen

Ik probeer met het onderstaand code gegevens van een oude workbook "Old" te kopieren naar een nieuw workbook "New" . Mijn code heb ik in een ander (3e)workbook "Transfer". In het workbook "New" heb ik data in kolom A tm Z niet aan eengesloten. Mijn probleem is dat ik het laatste rij niet kan vinden. als het om 1 kolom gaat dan lukt het wel.

Mijn 2e vraag is hoe kan dmv code controlen of een sheet (vet gedrukt in vba code) bestaat, als het bestaat dan moeten de gegevens gekopieerd worden.

Alvast bedankt

Groeten

Roso

Code:
Sub Transfer()
Application.ScreenUpdating = False

Dim vFilename
Dim vFilename2
       
   'FullFileName = Application.GetOpenFilename("Excel files (*.xl*),*.xl*", _
    1, "Custom Dialog Title", , False)

   
        'Old masterlist
        vFilename = Application.GetOpenFilename("Excel bestanden (*.xls), *.xls", , "Select Old Masterlist")
    
        'New Masterlist
        vFilename2 = Application.GetOpenFilename("Excel bestanden (*.xls), *.xls)", , "Select New Masterlist")
        
    'kijk of er een bestand is geselecteerd
      
    If vFilename <> False Then
        
         Set wbk = Workbooks.Open(vFilename)

    With wbk.[B]Sheets("Hall")[/B]
        Range("A2:E" & Range("A65536").End(xlUp).Row).Copy
    End With

 Set Wbk2 = Workbooks.Open(vFilename2)
 Wbk2.Sheets("Masterlist").Select
 With Wbk2.Sheets("Masterlist")
  
   [B][COLOR="red"] Range("A" & Range("A65536").End(xlUp).Row).Offset(1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False[/COLOR][/B]  
    .Range("A:AZ").Columns.AutoFit
    Application.CutCopyMode = False
 End With
   
        
       End If
    
    If vFilename = False Then Exit Sub
    If vFilename2 = False Then Exit Sub
End Sub
 
Code:
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function
 
Hoi Rudi,

Ten eerst mijn EXCUSES dat ik zo laat reageer, ik moest vandaag werken + overwerk dan weet je het wel.

Rudi bedankt voor je oplossing het werkt goed.:thumb:

Weet je mischien ook hoe ik, laatste lege rij in een sheet ('new') kan vinden vinden.
Ik gebruik de kolommen A tm Z deze zijn niet aaneengesloten gevuld met gegevens.

Ik gebruik nu deze code:
Code:
Range("A" & Range("A65536").End(xlUp).Row).Offset(1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Maar met deze code word in 1 kolom gekeken.

Nogmaals mij Hartelijk Dank.

Groeten,

Roso
 
Iedereen BEDANKT voor meedenken en Rudi jij bedankt voor de Oplossing.
door Jou ben ik ook in deze richting gaan denken, ik ben een amateur maar met jullie hulp kom een eind en leer heel veel.

Bijdeze mijn oplossing voor een ander die nodig kan hebben.

Code:
Public Function LastRowWithData() As Long

      Dim ExcelLastCell As Object, lRow As Long, lLastDataRow As Long, l As Long

      Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
      lLastDataRow = ExcelLastCell.Row
      lRow = ExcelLastCell.Row
   
      Do While Application.CountA(ActiveSheet.Rows(lRow)) = 0 And lRow <> 1
      lRow = lRow - 1
    Loop

    lLastDataRow = lRow

    LastRowWithData = lLastDataRow

 End Function


Bedankt en Groeten,

Roso
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan